Excelの資料の業務ツール⑤(フォントサイズ)

技術ブログ
2025.12.02

今回は「フォントサイズ」を新規で追加致しました。

前提としてWindows10の端末で実行する環境以下のコードを実行しました

<html>
<head>
<meta charset="UTF-8">

<HTA:APPLICATION
    ID="HTAExcelTool"
    BORDER="dialog"
    CAPTION="yes"
    SCROLL="no"
/>

<title>業務効率化ツール</title>

<style>
body {
    font-family: Meiryo;
    background-color: #f5f5f5;   /* ← 画面のベース背景色 */
}

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;
    background-color: white;    /* ← 追加 */
}

td{
    padding: 4px 10px;
    border: 1px solid black;
    text-align:center;
}
</style>

<script language="VBScript">
' ==========================================
' 列定義
' ==========================================
' 休暇管理台帳は 13 列のため maxCols を拡張
Dim maxCols : maxCols = 13

' 固定見出し
Dim vacationHeaders
vacationHeaders = Array("日付","4月","5月","6月","7月","8月","9月","10月","11月","12月","1月","2月","3月")

Dim envHeaders
envHeaders = Array("パラメーター","説明","設定値","初期値","設計方針")

Dim reportHeaders
reportHeaders = Array("日付","作業場所","作業予定","連絡事項","本日の作業内容")

' ==========================================
' 初期化
' ==========================================
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

    ' 開始列
    For i = 1 To 3
        Set opt = document.createElement("OPTION")
        opt.Value = i
        opt.InnerText = i
        txtStartCol.AppendChild opt
    Next

    ' 開始行
    For i = 1 To 5
        Set opt = document.createElement("OPTION")
        opt.Value = i
        opt.InnerText = i
        txtStartRow.AppendChild opt
    Next

    ' フォントサイズ
    For i = 8 To 28
        Set opt = document.createElement("OPTION")
        opt.Value = i
        opt.InnerText = i & " pt"
        fontSizeSelect.AppendChild opt
    Next
    fontSizeSelect.Value = 11

    UpdateInputs

    rad1.onclick = GetRef("ControlColumnInputs")
    rad2.onclick = GetRef("ControlColumnInputs")
    rad3.onclick = GetRef("ControlColumnInputs")
    rad4.onclick = GetRef("ControlColumnInputs")

    ControlColumnInputs
End Sub

' ==========================================
' 入力欄描画
' ==========================================
Sub UpdateInputs()
    Dim cols,i,html, inputWidth

    ' 列数はドロップダウンに従う
    cols = CLng(colSelect.Value)

    ' 幅設定
    If rad1.Checked Then
        inputWidth = "75px"  ' 休暇管理台帳だけ狭め
    Else
        inputWidth = "150px" ' その他は標準幅
    End If

    html = "<table><tr>"

    ' 見出し
    If rad1.Checked Then
        For i = 0 To 12
            html = html & "<td>" & vacationHeaders(i) & "</td>"
        Next
    ElseIf rad3.Checked Then
        For i = 0 To 4
            html = html & "<td>" & envHeaders(i) & "</td>"
        Next
    ElseIf rad2.Checked Then
        For i = 0 To 4
            html = html & "<td>" & reportHeaders(i) & "</td>"
        Next
    Else ' 手動操作や自由列
        For i = 1 To cols
            html = html & "<td>項目" & i & "</td>"
        Next
    End If

    html = html & "</tr><tr>"

    ' 入力欄
    For i = 1 To cols
        html = html & "<td><input type='text' id='txt" & i & "' style='width:" & inputWidth & ";font-size:12px;'></td>"
    Next

    html = html & "</tr></table>"

    inputArea.innerHTML = html
End Sub

' ==========================================
' 入力制御
' ==========================================
Sub ControlColumnInputs()
    Dim i,obj

    ' 全解放
    For i = 1 To maxCols
        Set obj = document.getElementById("txt"&i)
        If Not obj Is Nothing Then obj.Disabled = False
    Next

    If rad1.Checked Then
        colSelect.Value = 13
        colSelect.Disabled = True
        UpdateInputs
        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 rad2.Checked Then
        colSelect.Value = 5
        colSelect.Disabled = True
        UpdateInputs
        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 rad3.Checked Then
        colSelect.Value = 5
        colSelect.Disabled = True
        UpdateInputs
        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 rad4.Checked Then ' 手動操作
        colSelect.Value = 3
        If colSelect.Value = "" Then colSelect.Value = 3
        colSelect.Disabled = False
        UpdateInputs
    Else
        colSelect.Disabled = False
        UpdateInputs
    End If
End Sub

' ==========================================
' Excel 作成
' ==========================================
Sub CreateExcel()

    Dim xlApp,xlBook,xlSheet
    Dim i,cols,startCol,startRow,borderRows
    Dim headerRange,fullRange,bgColor

    Set xlApp = CreateObject("Excel.Application")
    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)

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

    ' ===== 見出し出力 =====
    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

    ' ===== 書式設定 =====
    borderRows = CLng(document.getElementById("txtBorderRows").value)
    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  ' xlCenter
    fullRange.VerticalAlignment   = -4108  ' xlCenter

    xlBook.SaveAs document.getElementById("txtFolder").value & "\" & _
                  document.getElementById("txtFile").value

    xlBook.Close False
    xlApp.Quit

    MsgBox "Excelファイルを作成しました。"

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"></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>
</tr>
</table>

<p style="font-weight:bold;color:blue;">
２．利用する帳票を選択してください（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;">
３．作成する列数と、各列の入力値を指定してください。
</p>

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

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

<table>
<tr>
<td>罫線行数</td>
<td>フォント</td>
<td>背景色</td>
<td>フォントサイズ</td>
</tr>
<tr>
<td><input id="txtBorderRows" 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>
<td><select id="fontSizeSelect"></select></td>
</tr>
</table>

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

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