Excelの表作成を効率化するため、保存先やファイル名、列数、項目名を画面上から指定できる
ツールを作成しました。完成したツールの画面イメージは、以下のとおりです。
※Windows10でもWindows11の両方でも利用できます。もちろんExcel向けの作業効率の
ツールであるため、Officeが入っていることは前提です。
<html>
<head>
<meta charset="UTF-8">
<HTA:APPLICATION
ID="HTAExcelTool"
BORDER="dialog"
CAPTION="yes"
SCROLL="no"
/>
<title>Excel 可変列入力ツール</title>
<style>
body {
font-family: Meiryo;
}
select{
width:120px;
height:24px;
font-size:14px;
color: WindowText;
background-color: Window;
}
option{
color: WindowText;
background-color: Window;
}
/* 基本情報の入力欄 */
#txtFolder, #txtFile, #txtSheet {
width:200px;
}
/* 開始列と開始行だけ幅を半分に */
#txtStartCol, #txtStartRow {
width:100px;
}
/* Excel列用入力欄 */
#inputArea input {
width:165px;
}
table{
border-collapse: collapse;
margin-top: 10px;
border: 1px solid black;
}
td{
padding: 4px 10px;
border: 1px solid black;
text-align:center;
}
</style>
<script language="VBScript">
Dim maxCols
maxCols = 10
' 初期化 Sub
Sub Init()
Dim i, opt
' 列数プルダウン初期化
Do While colSelect.options.length > 0
colSelect.remove 0
Loop
For i = 1 To maxCols
Set opt = document.createElement("OPTION")
opt.innerText = i & " 列"
opt.value = i
colSelect.appendChild opt
Next
colSelect.value = 3
UpdateInputs
End Sub
' Excel列入力欄描画
Sub UpdateInputs()
Dim cols, i, html
cols = CLng(colSelect.value)
html = "<table><tr>"
' 見出し
For i = 1 To cols
html = html & "<td>項目" & i & "</td>"
Next
html = html & "</tr><tr>"
' 入力欄
For i = 1 To cols
html = html & "<td><input type='text' id='txt" & i & "'></td>"
Next
html = html & "</tr></table>"
inputArea.innerHTML = html
End Sub
' Excel作成 Sub
Sub CreateExcel()
Dim saveFolder, fileName, sheetName, fullPath
Dim xl, wb, i, cols
Dim startCol, startRow
' 基本情報取得
saveFolder = Trim(txtFolder.value)
fileName = Trim(txtFile.value)
sheetName = Trim(txtSheet.value)
startCol = CLng(Trim(txtStartCol.value))
startRow = CLng(Trim(txtStartRow.value))
If saveFolder = "" Or fileName = "" Or sheetName = "" Then
MsgBox "格納先・ファイル名・シート名をすべて入力してください。", 48, "未入力"
Exit Sub
End If
' 拡張子補正
If LCase(Right(fileName, 5)) <> ".xlsx" Then
fileName = fileName & ".xlsx"
End If
fullPath = saveFolder & "\" & fileName
' Excel操作
cols = CLng(colSelect.value)
' Excel起動・Workbook作成
Set xl = CreateObject("Excel.Application")
xl.Visible = False
xl.DisplayAlerts = False
Set wb = xl.Workbooks.Add()
' シート名変更
wb.Sheets(1).Name = sheetName
' 見出し
For i = 1 To cols
wb.Sheets(1).Cells(startRow, startCol + i - 1).Value = "項目" & i
Next
' データ
For i = 1 To cols
wb.Sheets(1).Cells(startRow + 1, startCol + i - 1).Value = document.getElementById("txt" & i).value
Next
' 保存・終了
wb.SaveAs fullPath
wb.Close
xl.Quit
Set wb = Nothing
Set xl = Nothing
MsgBox "Excel 作成完了" & vbCrLf & fullPath
End Sub
</script>
</head>
<body onload="Call Init">
<h3>Excel 作成ツール</h3>
<p style="font-weight:bold; color:blue;">
下記の入力欄に、保存先やファイル名を入力してください。
</p>
<!-- 基本情報 -->
<table>
<tr>
<td>格納先</td>
<td>ファイル名</td>
<td>初回シート名</td>
<td>開始列</td>
<td>開始行</td>
</tr>
<tr>
<td><input type="text" id="txtFolder" value=""></td>
<td><input type="text" id="txtFile" value="sample.xlsx"></td>
<td><input type="text" id="txtSheet" value="Sheet1"></td>
<td><input type="text" id="txtStartCol" value="2"></td>
<td><input type="text" id="txtStartRow" value="2"></td>
</tr>
</table>
<br>
<!-- 列数選択 -->
<p style="font-weight:bold; color:blue;">
作成する Excel の表の列数を選択し、各列の項目名を入力してください。
</p>
Excelの表は何列にしますか？：
<select id="colSelect" onchange="UpdateInputs()"></select>
<div id="inputArea"></div>
<br>
<button onclick="CreateExcel()">Excel作成</button>
</body>
</html>
