Excelの資料の業務ツール④(項目の背景色)

技術ブログ
2025.12.01

今回は項目の背景色をコントロールする機能を追加しました。

前提として私の環境(Windows10)ではできておりますので、コードは以下を参照してください。

<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;
}
option{
    background-color: Window;
}

/* 基本情報の入力欄 */
#txtFolder, #txtFile, #txtSheet {
    width:200px;
}

/* 開始列と開始行 */
#txtStartCol, #txtStartRow {
    width:100px;
}

/* 入力項目 */
#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 Init()

    Dim i, opt

    ' 列数選択
    For i = 1 To maxCols
        Set opt = document.createElement("OPTION")
        opt.value = i
        opt.innerText = i & " 列"
        colSelect.appendChild opt
    Next
    colSelect.value = 3


    ' 開始列（1～3）
    For i = 1 To 3
        Set opt = document.createElement("OPTION")
        opt.value = i
        opt.innerText = i
        txtStartCol.appendChild opt
    Next
    txtStartCol.value = 2


    ' 開始行（1～5）
    For i = 1 To 5
        Set opt = document.createElement("OPTION")
        opt.value = i
        opt.innerText = i
        txtStartRow.appendChild opt
    Next
    txtStartRow.value = 2


    UpdateInputs

End Sub


' ==========================
' 列入力欄描画
' ==========================
Sub UpdateInputs()

    Dim cols, i, html

    If IsNumeric(colSelect.value) Then
        cols = CLng(colSelect.value)
    Else
        cols = 1
    End If

    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 CreateExcel()

    Dim saveFolder, fileName, sheetName, fullPath
    Dim xl, wb, i, cols
    Dim startCol, startRow
    Dim borderRows
    Dim lastCol, lastRow

    ' -------- 基本入力 --------
    saveFolder = Trim(txtFolder.value)
    fileName   = Trim(txtFile.value)
    sheetName  = Trim(txtSheet.value)

    If saveFolder = "" Or fileName = "" Or sheetName = "" Then
        MsgBox "格納先・ファイル名・シート名は必須です", 48
        Exit Sub
    End If


    ' -------- 数値安全取得 --------
    If IsNumeric(txtStartCol.value) Then
        startCol = CLng(txtStartCol.value)
    Else
        startCol = 1
    End If

    If IsNumeric(txtStartRow.value) Then
        startRow = CLng(txtStartRow.value)
    Else
        startRow = 1
    End If

    If IsNumeric(txtBorderRows.value) Then
        borderRows = CLng(txtBorderRows.value)
    Else
        borderRows = 1
    End If

    If borderRows < 1 Then borderRows = 1


    ' 列数
    If IsNumeric(colSelect.value) Then
        cols = CLng(colSelect.value)
    Else
        cols = 1
    End If


    ' -------- 保存先 --------
    If LCase(Right(fileName,5)) <> ".xlsx" Then
        fileName = fileName & ".xlsx"
    End If

    fullPath = saveFolder & "\" & fileName


    ' -------- Excel操作 --------
    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 = document.getElementById("txt" & i).value
    Next


    ' -------- 罫線 --------
    lastCol = startCol + cols - 1
    lastRow = startRow + borderRows

    With wb.Sheets(1).Range( _
            wb.Sheets(1).Cells(startRow, startCol), _
            wb.Sheets(1).Cells(lastRow, lastCol) )

        .Borders.LineStyle = 1
        .Borders.Weight = 2
        .Font.Name = fontSelect.value

    End With

    '--------------------------------------
    ' 背景色（項目行のみ）
    
    Dim bgColor
    
    bgColor = bgColorSelect.value
    
    With wb.Sheets(1).Range( _
            wb.Sheets(1).Cells(startRow, startCol), _
            wb.Sheets(1).Cells(startRow, lastCol))
    
        .Interior.Color = CLng("&H" & _
            Mid(bgColor,6,2) & _
            Mid(bgColor,4,2) & _
            Mid(bgColor,2,2))
    
    End With

    ' -------- 列幅 --------
    If startCol <> 1 Then
        wb.Sheets(1).Columns(1).ColumnWidth = _
            wb.Sheets(1).Columns(1).ColumnWidth / 3
    End If


    ' -------- 保存 --------
    wb.SaveAs fullPath
    wb.Close
    xl.Quit

    Set wb = Nothing
    Set xl = Nothing


    MsgBox "Excel 作成完了" & vbCrLf & fullPath

End Sub

</script>
</head>

<body onload="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 id="txtFolder" type="text"></td>
    <td><input id="txtFile" type="text" value="sample.xlsx"></td>
    <td><input id="txtSheet" type="text" value="Sheet1"></td>
    <td><select id="txtStartCol"></select></td>
    <td><select id="txtStartRow"></select></td>
</tr>
</table>

<p style="font-weight:bold;color:blue;">
作成する列数と、各列の入力値を指定してください。
</p>

Excelの表の項目は何列にしますか？：
<select id="colSelect" onchange="UpdateInputs()"></select>

<div id="inputArea"></div>

<br>

<p style="font-weight:bold;color:blue;">
設定項目数は行数とフォントの種類を指定してください。
</p>

<table>
<tr>
    <td>罫線行数</td>
    <td>フォント</td>
    <td>項目の背景色</td>
</tr>
<tr>
    <td>
        <input id="txtBorderRows" type="text" value="1">
    </td>
    <td>
        <select id="fontSelect">
            <option value="ＭＳ ゴシック">ＭＳ ゴシック</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>
</tr>
</table>

<br>

<button onclick="CreateExcel()">Excel 作成</button>

</body>
</html>
タイトルとURLをコピーしました