Excelの資料の業務ツール⑥(画面表示)
これまではコーティングしている作業のディスプレイの画面サイズに合わしていたけどPCのディスプレイでもノートPCのどちらでも見やすい文字の大きさに合わせられるよう画面サイズをコントロールする機能を追加しました。Windows10でもWindows11の両方でも利用できます。もちろんExcel向けの作業効率のツールであるため、Officeが入っていることは前提です。<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, input{ width:180px;}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;}/* 入力テーブルの横スクロール有効化 */#scrollWrap { width: 100%; overflow-x: auto; padding-bottom: 18px; margin-bottom: 10px;}</style><script language="VBScript">' ==========================================' 列定義' ==========================================Dim maxCols maxCols = 13Dim vacationHeadersvacationHeaders = Array("日付","4月","5月","6月","7月","8月","9月","10月","11月","12月","1月","2月","3月")Dim envHeadersenvHeaders = Array("パラメーター","説明","設定値","初期値","設計方針")Dim reportHeadersreportHeaders = Array("日付","作業場所","作業予定","連絡事項","本日の作業内容")' ==========================================' サイズ切り替えサブルーチン' ==========================================Sub ToggleFontSize(size) Dim uiFontSize uiFontSize = size ' bodyにフォントサイズを設定 document.body.style.fontSize = uiFontSize & "px" ' select/inputにサイズを強制適用し、高さを調整 Dim elements elements = Array("select", "input") Dim tag, element For Each tag In elements For Each element In document.getElementsByTagName(tag) ' type="radio" は除く If element.type <> "radio" Then element.style.fontSize = uiFontSize & "px" ' 高さをフォントサイズに合わせて調整 (例: 1.7倍) element.style.height = (uiFontSize * 1.7) & "px" End If Next NextEnd 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 & ";'></td>" Next html = html & "</tr></table>" inputArea.innerHTML = htmlEnd 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 IfEnd 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' ==========================================' 初期化' ==========================================Sub Init() Dim i, opt ' デフォルトサイズをノートPC向け(16px)に設定 ToggleFontSize(16) ' 列数 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 txtStartCol.Value = 2 ' 開始行 For i = 1 To 5 Set opt = document.createElement("OPTION") opt.Value = i opt.InnerText = i txtStartRow.AppendChild opt Next txtStartRow.Value = 2 ' Excelのフォントサイズ選択肢を生成 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 ' HTA表示サイズプルダウンの初期値設定 document.getElementById("fontSizeToggle").value = 16 rad1.onclick = GetRef("ControlColumnInputs") rad2.onclick = GetRef("ControlColumnInputs") rad3.onclick = GetRef("ControlColumnInputs") rad4.onclick = GetRef("ControlColumnInputs") ControlColumnInputsEnd Sub</script></head><body onload="Init"><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></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></tr></table><br><button onclick="CreateExcel()">Excel 作成</button></body></html>