シートの複製を有効にしたら初期シートが追加されます

Windows10でもWindows11の両方でも利用できます。もちろんExcel向けの作業効率のツールで
あるため、Officeが入っていることは前提です。
<html>
<head>
<meta charset="UTF-8">
<HTA:APPLICATION
ID="HTAExcelTool"
BORDER="dialog"
CAPTION="yes"
SCROLL="no"
/>
<title>業務効率化ツール</title>
<style>
/* ==========================================
* CSS スタイル定義
* ========================================== */
body {
font-family: Meiryo;
background-color: #f5f5f5;
}
/* コンテンツ全体の左側の基準位置を統一し、さらに左に寄せる (5px) */
#mainContent {
padding-left: 5px;
}
select, input{
width:180px;
}
option{
background-color: Window;
}
/* 開始列と開始行の選択ドロップダウンの幅を調整 */
#txtStartCol, #txtStartRow {
width:100px;
}
/* 表のスタイル設定 */
table{
border-collapse: collapse;
margin-top: 10px;
border: 1px solid black;
background-color: white;
}
/* TDのパディングを元の値に戻します */
td{
padding: 4px 10px;
border: 1px solid black;
text-align:center;
}
/* 入力テーブルの横スクロール有効化 */
#scrollWrap {
width: 100%;
overflow-x: auto;
padding-bottom: 18px;
margin-bottom: 10px;
padding-left: 0;
}
</style>
<script language="VBScript">
' ==========================================
' グローバル変数定義
' ==========================================
Dim g_fileInputWidth
Dim g_stdInputWidth
Dim g_narrowInputWidth
' 手動操作時の入力値を保持するための配列 (最大列数 13)
Dim g_manualValues(13)
' ==========================================
' 列定義
' ==========================================
Dim maxCols
maxCols = 13
' 休暇管理台帳 (rad1) 用のヘッダー定義
Dim vacationHeaders
vacationHeaders = Array("日付","4月","5月","6月","7月","8月","9月","10月","11月","12月","1月","2月","3月")
' 環境定義書 (rad3) 用のヘッダー定義
Dim envHeaders
envHeaders = Array("パラメーター","説明","設定値","初期値","設計方針")
' 業務管理日報 (rad2) 用のヘッダー定義
Dim reportHeaders
reportHeaders = Array("日付","作業場所","作業予定","連絡事項","本日の作業内容")
' ==========================================
' サイズ切り替えサブルーチン (ToggleFontSize)
' HTAの表示フォントサイズと、それに合わせた入力欄の幅を動的に調整する
' ==========================================
Sub ToggleFontSize(size)
Dim uiFontSize
uiFontSize = size
' --- 1. サイズに応じた入力欄の幅を決定 ---
' ユーザーの画面解像度やDPI設定に合わせて最適な入力幅をグローバル変数に設定
If uiFontSize <= 16 Then
' 16px (外部ディスプレイ): 最適化された狭い幅 (デフォルト値)
g_fileInputWidth = 250
g_stdInputWidth = 150
g_narrowInputWidth = 70
ElseIf uiFontSize <= 20 Then
' 20px (中DPI)
g_fileInputWidth = 400
g_stdInputWidth = 250
g_narrowInputWidth = 100
ElseIf uiFontSize <= 24 Then
' 24px (標準ノートPC)
g_fileInputWidth = 450
g_stdInputWidth = 300
g_narrowInputWidth = 120
Else ' 27px, 30px (高DPI/ノートPC向け)
' 27px, 30px: ノートPCでの見やすさを優先した広い幅
g_fileInputWidth = 500
g_stdInputWidth = 350
g_narrowInputWidth = 150
End If
document.body.style.fontSize = uiFontSize & "px"
' --- 2. 静的なファイル入力要素の幅を動的に設定 ---
' 格納先、ファイル名、シート名などの入力ボックスの幅を調整
Dim elementsToResize
elementsToResize = Array("txtFolder", "txtFile", "txtSheet")
Dim elementID, objElement
For Each elementID In elementsToResize
Set objElement = document.getElementById(elementID)
If Not objElement Is Nothing Then
objElement.style.width = g_fileInputWidth & "px"
End If
Next
' --- 3. その他要素のフォントサイズと高さ調整 ---
' select要素やinput要素全体のフォントサイズと高さを調整
Dim elements
elements = Array("select", "input")
Dim tag, element
For Each tag In elements
For Each element In document.getElementsByTagName(tag)
If element.type <> "radio" Then
element.style.fontSize = uiFontSize & "px"
element.style.height = (uiFontSize * 1.7) & "px"
End If
Next
Next
' --- 4. HTA表示サイズの変更時、動的に生成された入力欄の幅を更新し、値を復元 ---
If Not document.getElementById("colSelect") Is Nothing Then
Dim i, selectedRad
' 手動操作時のみ、現在の入力を一時配列に退避 (VBScript重複行バグ修正済み)
If rad4.Checked Then
For i = 1 To colSelect.Value
If Not document.getElementById("txt"&i) Is Nothing Then
g_manualValues(i) = document.getElementById("txt"&i).value
End If
Next
End If
' 入力欄の再描画 (CSS幅を更新するため UpdateInputs を呼び出す)
UpdateInputs
' 現在チェックされているラジオボタンを特定
If rad1.Checked Then
selectedRad = 1
ElseIf rad2.Checked Then
selectedRad = 2
ElseIf rad3.Checked Then
selectedRad = 3
ElseIf rad4.Checked Then
selectedRad = 4
End If
' 項目名、Disabled状態、入力値を再適用
If selectedRad <> "" Then
ReapplyColumnSettings selectedRad
End If
End If
End Sub
' ==========================================
' 入力欄描画 (UpdateInputs)
' ==========================================
Sub UpdateInputs()
Dim cols,i,html, inputWidth, headerCols
If colSelect.Value = "" Then
cols = 3
Else
cols = CLng(colSelect.Value)
End If
' --- 幅設定をグローバル変数から取得 ---
If rad1.Checked Then
inputWidth = g_narrowInputWidth & "px"
Else
inputWidth = g_stdInputWidth & "px"
End If
html = "<table><tr>"
' --- テーブル見出し(ヘッダー)の生成 ---
' どのモードでもヘッダーを「項目n」に統一
If rad1.Checked Then headerCols = 13
If rad2.Checked Then headerCols = 5
If rad3.Checked Then headerCols = 5
If rad4.Checked Then headerCols = cols
For i = 1 To headerCols
html = html & "<td>項目" & i & "</td>"
Next
html = html & "</tr><tr>"
' --- 入力欄(テキストボックス)の生成 ---
For i = 1 To cols
html = html & "<td><input type='text' id='txt" & i & "' style='width:" & inputWidth & ";'></td>"
Next
html = html & "</tr></table>"
inputArea.innerHTML = html
End Sub
' ==========================================
' 項目設定再適用 (ReapplyColumnSettings)
' ==========================================
Sub ReapplyColumnSettings(radNum)
Dim i, obj
If radNum = 1 Then
' 休暇管理台帳
For i = 1 To 13
Set obj = document.getElementById("txt"&i)
If Not obj Is Nothing Then
obj.Value = vacationHeaders(i-1)
obj.Disabled = True ' 入力不可
End If
Next
ElseIf radNum = 2 Then
' 業務管理日報
For i = 1 To 5
Set obj = document.getElementById("txt"&i)
If Not obj Is Nothing Then
obj.Value = reportHeaders(i-1)
obj.Disabled = True ' 入力不可
End If
Next
ElseIf radNum = 3 Then
' 環境定義書
For i = 1 To 5
Set obj = document.getElementById("txt"&i)
If Not obj Is Nothing Then
obj.Value = envHeaders(i-1)
obj.Disabled = True ' 入力不可
End If
Next
ElseIf radNum = 4 Then
' 手動操作
For i = 1 To colSelect.Value
Set obj = document.getElementById("txt"&i)
If Not obj Is Nothing Then
obj.Value = g_manualValues(i)
obj.Disabled = False ' 入力可能
End If
Next
End If
' 列数の無効化/有効化も適用
If radNum >= 1 And radNum <= 3 Then
colSelect.Disabled = True
ElseIf radNum = 4 Then
colSelect.Disabled = False
End If
End Sub
' ==========================================
' 入力制御 (ControlColumnInputs)
' ==========================================
Sub ControlColumnInputs()
Dim i, obj, radNum
' --- 1. 全ての入力欄を一旦有効化(前回の設定をクリア) ---
For i = 1 To maxCols
Set obj = document.getElementById("txt"&i)
If Not obj Is Nothing Then obj.Disabled = False
Next
' --- 2. 帳票種別に応じて、列数と初期値を設定 ---
If rad1.Checked Then
colSelect.Value = 13
radNum = 1
ElseIf rad2.Checked Then
colSelect.Value = 5
radNum = 2
ElseIf rad3.Checked Then
colSelect.Value = 5
radNum = 3
ElseIf rad4.Checked Then ' 手動操作
If colSelect.Value = "" Then colSelect.Value = 3
radNum = 4
' 手動操作に切り替わったとき、一時配列を初期化(これにより入力ボックスが空欄になる)
For i = 1 To 13
g_manualValues(i) = ""
Next
End If
' --- 3. 入力欄を再描画 ---
UpdateInputs
' --- 4. 項目名と Disabled 状態を適用 ---
ReapplyColumnSettings radNum
End Sub
' ==========================================
' Excel 作成 (CreateExcel)
' Excelオブジェクトを起動し、指定されたパラメータで表を作成する
' ==========================================
Sub CreateExcel()
Dim xlApp,xlBook,xlSheet
Dim i,cols,startCol,startRow,borderRows
Dim headerRange,fullRange,bgColor
Dim duplicateFlag
' --- Excel アプリケーションの起動とエラーチェック ---
On Error Resume Next
Set xlApp = CreateObject("Excel.Application")
If Err.Number <> 0 Then
MsgBox "Excelアプリケーションの起動に失敗しました。Excelがインストールされているか確認してください。", 16, "エラー"
Exit Sub
End If
On Error GoTo 0
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
xlSheet.Name = document.getElementById("txtSheet").value
startCol = CLng(document.getElementById("txtStartCol").value)
startRow = CLng(document.getElementById("txtStartRow").value)
cols = CLng(document.getElementById("colSelect").value)
borderRows = CLng(document.getElementById("txtBorderRows").value) ' 罫線行数を取得
' -------- 列幅と行の幅の調整 --------
If rad1.Checked Then
xlSheet.Columns(startCol).ColumnWidth = 17
For i = startCol + 1 To startCol + cols - 1
xlSheet.Columns(i).ColumnWidth = 13
Next
xlSheet.Range(xlSheet.Cells(startRow, startCol), xlSheet.Cells(startRow + borderRows, startCol)).RowHeight = 26
ElseIf rad2.Checked Then
xlSheet.Columns(startCol).ColumnWidth = 15
xlSheet.Columns(startCol + 1).ColumnWidth = 20
For i = startCol + 2 To startCol + cols - 1
xlSheet.Columns(i).ColumnWidth = 65
Next
xlSheet.Range(xlSheet.Cells(startRow, startCol), xlSheet.Cells(startRow + borderRows, startCol)).RowHeight = 65
End If
' A列(Excelの物理的な1列目)の幅を調整するロジック
' ※ rad1/rad2/rad3/rad4 に関係なく実行されるように修正済み
If startCol <> 1 Then
xlSheet.Columns(1).ColumnWidth = _
xlSheet.Columns(1).ColumnWidth / 3
End If
' ===== 見出し出力 (Excelの1行目) =====
If rad1.Checked Then
For i = 0 To 12
xlSheet.Cells(startRow,startCol+i).Value = vacationHeaders(i)
Next
ElseIf rad3.Checked Then
For i = 0 To 4
xlSheet.Cells(startRow,startCol+i).Value = envHeaders(i)
Next
ElseIf rad2.Checked Then
For i = 0 To 4
xlSheet.Cells(startRow,startCol+i).Value = reportHeaders(i)
Next
Else
For i = 1 To cols
xlSheet.Cells(startRow,startCol+i-1).Value = document.getElementById("txt"&i).Value
Next
End If
' ===== 書式設定 =====
bgColor = document.getElementById("bgColorSelect").value
Set headerRange = xlSheet.Range( _
xlSheet.Cells(startRow,startCol), _
xlSheet.Cells(startRow,startCol+cols-1))
headerRange.Interior.Color = RGB( _
CInt("&H"&Mid(bgColor,2,2)), _
CInt("&H"&Mid(bgColor,4,2)), _
CInt("&H"&Mid(bgColor,6,2)))
Set fullRange = xlSheet.Range( _
xlSheet.Cells(startRow,startCol), _
xlSheet.Cells(startRow+borderRows,startCol+cols-1))
fullRange.Font.Name = document.getElementById("fontSelect").value
fullRange.Font.Size = CLng(document.getElementById("fontSizeSelect").value)
fullRange.Borders.LineStyle = 1
fullRange.HorizontalAlignment = -4108
fullRange.VerticalAlignment = -4108
' ==========================================
' ★ シート複製処理追加 ★
' ==========================================
duplicateFlag = document.getElementById("chkDuplicateSheet").checked
If duplicateFlag = True Then
xlSheet.Copy , xlSheet
xlBook.Sheets(2).Name = xlSheet.Name & "_コピー"
End If
On Error Resume Next
xlBook.SaveAs document.getElementById("txtFolder").value & "\" & _
document.getElementById("txtFile").value
If Err.Number <> 0 Then
MsgBox "ファイルの保存に失敗しました。格納先フォルダが存在するか、ファイル名が正しいか確認してください。", 16, "エラー"
xlBook.Close False
xlApp.Quit
Exit Sub
End If
On Error GoTo 0
xlBook.Close False
xlApp.Quit
MsgBox "Excelファイルを作成しました。"
End Sub
' ==========================================
' 初期化 (Init)
' ==========================================
Sub Init()
Dim i, opt
' デフォルトサイズを外部ディスプレイ向け(16px)に設定
ToggleFontSize(16)
' --- 列数ドロップダウン(colSelect)の項目生成 ---
For i = 1 To maxCols
Set opt = document.createElement("OPTION")
opt.Value = i
opt.InnerText = i & " 列"
colSelect.AppendChild opt
Next
colSelect.Value = 13
' --- 開始列ドロップダウン(txtStartCol)の項目生成 ---
For i = 1 To 3
Set opt = document.createElement("OPTION")
opt.Value = i
opt.InnerText = i
txtStartCol.AppendChild opt
Next
txtStartCol.Value = 2
' --- 開始行ドロップダウン(txtStartRow)の項目生成 ---
For i = 1 To 5
Set opt = document.createElement("OPTION")
opt.Value = i
opt.InnerText = i
txtStartRow.AppendChild opt
Next
txtStartRow.Value = 2
' --- Excelフォントサイズドロップダウン(fontSizeSelect)の項目生成 ---
For i = 8 To 28
Set opt = document.createElement("OPTION")
opt.Value = i
opt.InnerText = i & " pt"
fontSizeSelect.AppendChild opt
Next
fontSizeSelect.Value = 11
' HTA表示サイズプルダウンの初期値設定(デフォルト: 16px)
document.getElementById("fontSizeToggle").value = 16
' --- ラジオボタンのクリックイベントに関数をバインド ---
rad1.onclick = GetRef("ControlColumnInputs")
rad2.onclick = GetRef("ControlColumnInputs")
rad3.onclick = GetRef("ControlColumnInputs")
rad4.onclick = GetRef("ControlColumnInputs")
ControlColumnInputs ' 画面初期表示時の入力制御を適用(rad1=休暇管理台帳が初期チェック状態)
End Sub
</script>
</head>
<body onload="Init">
<div id="mainContent">
<h3>Excel 作成ツール </h3>
<p style="font-weight:bold;color:blue;">
1.保存情報および開始位置・罫線設定を入力してください。
</p>
<table>
<tr>
<td>格納先</td>
<td>ファイル名</td>
<td>初回シート名</td>
<td>開始列</td>
<td>開始行</td>
<td>表示サイズ調整</td> </tr>
<tr>
<td><input id="txtFolder"></td>
<td><input id="txtFile" value="sample.xlsx"></td>
<td><input id="txtSheet" value="Sheet1"></td>
<td><select id="txtStartCol"></select></td>
<td><select id="txtStartRow"></select></td>
<td>
<select id="fontSizeToggle" onchange="ToggleFontSize(document.getElementById('fontSizeToggle').value)">
<option value="16">16 px (外部ディスプレイ)</option>
<option value="20">20 px (中DPI)</option>
<option value="24">24 px (標準ノートPC)</option>
<option value="27">27 px (高DPI/初期値)</option>
<option value="30">30 px (特大)</option>
</select>
</td>
</tr>
</table>
<p style="font-weight:bold;color:blue;">
2.利用する帳票を選択してください(1つだけ選択可):
</p>
<table>
<tr>
<td>休暇管理台帳</td>
<td>業務管理日報</td>
<td>環境定義書</td>
<td>手動操作</td>
</tr>
<tr>
<td><input type="radio" name="r" id="rad1" checked></td>
<td><input type="radio" name="r" id="rad2"></td>
<td><input type="radio" name="r" id="rad3"></td>
<td><input type="radio" name="r" id="rad4"></td>
</tr>
</table>
<p style="font-weight:bold;color:blue;">
3.作成する列数と、各列の入力値を指定してください。
</p>
Excelの表の項目は何列にしますか?:
<select id="colSelect" onchange="UpdateInputs()"></select>
<div id="scrollWrap">
<div id="inputArea"></div>
</div>
<p style="font-weight:bold;color:blue;">
4.設定項目数は行数とフォントの種類を指定してください。
</p>
<table>
<tr>
<td>罫線行数</td>
<td>フォント</td>
<td>背景色</td>
<td>フォントサイズ</td>
<td>シート複製</td>
</tr>
<tr>
<td><input id="txtBorderRows" value="1"></td>
<td>
<select id="fontSelect">
<option value="MS ゴシック">MS ゴシック</option>
<option value="メイリオ">メイリオ</option>
<option value="Arial">Arial</option>
</select>
</td>
<td>
<select id="bgColorSelect">
<option value="#CCFFFF">水色</option>
<option value="#CCFFCC">黄緑</option>
<option value="#CCCCCC">グレー</option>
</select>
</td>
<td>
<select id="fontSizeSelect"></select>
</td>
<td>
<input type="checkbox" id="chkDuplicateSheet">
</td>
</tr>
</table>
<br>
<button onclick="CreateExcel()">Excel 作成</button>
</div>
</body>
</html>

