Excelの資料の業務ツール⑦(シート複製)

技術ブログ

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

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>
タイトルとURLをコピーしました