Option Explicit

' 共通シート名定義
Public Const SHEET_N_SASHI As String = "Nサッシ"
Public Const SHEET_N_TATEGU As String = "N建具"
Public Const SHEET_N_SETUBI As String = "N設備"
Public Const SHEET_N_ZATSU As String = "N雑工事"

Public Const SHEET_B_SASHI As String = "Bサッシ"
Public Const SHEET_B_TATEGU As String = "B建具"
Public Const SHEET_B_SETUBI As String = "B設備"
Public Const SHEET_B_ZATSU As String = "B雑工事"

Public Const SHEET_A_SASHI As String = "Aサッシ"
Public Const SHEET_A_TATEGU As String = "A建具"
Public Const SHEET_A_SETUBI As String = "A設備"
Public Const SHEET_A_ZATSU As String = "A雑工事"

Public Const SHEET_MITSUMORI As String = "見積書表紙"
Public Const SHEET_MEISAI As String = "明細書"
Public Const SHEET_KIHON As String = "基本入力"
Public Const SHEET_SHOKEIHI As String = "諸経費"


Sub 明細の抽出()
    ' 必要項目入力チェック
    If Not 必須入力チェック結果() Then
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Call 抽出シートクリア("抽出")
    Call 明細情報抽出("サッシ工事", "抽出")
    Call 明細情報抽出("建具工事", "抽出")
    Call 明細情報抽出("設備工事", "抽出")
    Call 明細情報抽出("雑工事", "抽出")

    Call 明細書シートに移動
    Call 明細書印刷範囲設定

    Application.ScreenUpdating = True
End Sub


' filepath: c:\Users\k.nogi\#GitHub\ken_nogi\pleasanter\develop\##実行予算承認WF\sites\scripts\抽出マクロ.vbs
Sub 明細情報抽出(ByVal categoryName As String, ByVal destSheetName As String)
    Dim srcWs As Worksheet, destWs As Worksheet
    Dim srcTbl As ListObject
    Dim srcTblF As ListObject
    Dim destRow As Long, i As Long
    Dim colProduct As Integer, colPrice As Integer, colQty As Integer, colUnitName As Integer
    Dim 金額 As Double, subtotal As Double
    Dim lastRow As Long
    Dim isFirst As Boolean

    '--- 対象のテーブル情報 ---
    Dim srcSheetName As String
    Dim srcTableName As String
    Dim srcTableNameF As String
    srcSheetName = Range(categoryName).Value
    srcTableName = Range(categoryName).Value
    srcTableNameF = srcTableName & "F"

    '--- 設定 ---
    Set srcWs = ThisWorkbook.Sheets(srcSheetName)
    Set destWs = ThisWorkbook.Sheets(destSheetName)
    Set srcTbl = srcWs.ListObjects(srcTableName)
    Set srcTblF = srcWs.ListObjects(srcTableNameF)

    '列番号取得（列名は実際のものに合わせてください）
    colProduct = srcTbl.ListColumns("商品名").Index
    colPrice = srcTbl.ListColumns("単価").Index
    colQty = srcTbl.ListColumns("数量").Index
    colUnitName = srcTbl.ListColumns("単位名").Index

    '--- データ書き込み開始行の決定 ---
    lastRow = destWs.Cells(destWs.Rows.Count, 1).End(xlUp).Row
    If destWs.Cells(1, 1).Value = "" Then
        ' シートが空の場合
        destRow = 1
        isFirst = True
    Else
        destRow = lastRow + 1
        isFirst = False
    End If

    '--- カテゴリ名・ヘッダー出力 ---
    destWs.Cells(destRow, 1).Value = categoryName
    destRow = destRow + 1

    subtotal = 0

    '--- データ抽出と金額計算 ---
    For i = 1 To srcTbl.ListRows.Count
        If srcTbl.DataBodyRange(i, colQty).Value > 0 Then
            destWs.Cells(destRow, 1).Value = "　" + srcTbl.DataBodyRange(i, colProduct).Value
            destWs.Cells(destRow, 2).Value = srcTbl.DataBodyRange(i, colPrice).Value

            ' 数量は小数点以下第3位以下を切り捨て
            Dim qtyValue As Double
            qtyValue = srcTbl.DataBodyRange(i, colQty).Value
            qtyValue = Int(qtyValue * 100) / 100
            destWs.Cells(destRow, 3).Value = qtyValue
            destWs.Cells(destRow, 4).Value = srcTbl.DataBodyRange(i, colUnitName).Value
            ' 金額は単価×数量で計算し、小数点以下切り捨て
            金額 = srcTbl.DataBodyRange(i, colPrice).Value * qtyValue
            金額 = Int(金額)
            destWs.Cells(destRow, 5).Value = 金額
            subtotal = subtotal + 金額
            destRow = destRow + 1
        End If
    Next i

    For i = 1 To srcTblF.ListRows.Count
        If srcTblF.DataBodyRange(i, colQty).Value > 0 Then
            destWs.Cells(destRow, 1).Value = "　" + srcTblF.DataBodyRange(i, colProduct).Value
            destWs.Cells(destRow, 2).Value = srcTblF.DataBodyRange(i, colPrice).Value

            ' 数量は小数点以下第3位以下を切り捨て
            Dim qtyValueF As Double
            qtyValueF = srcTblF.DataBodyRange(i, colQty).Value
            qtyValueF = Int(qtyValueF * 100) / 100
            destWs.Cells(destRow, 3).Value = qtyValueF
            destWs.Cells(destRow, 4).Value = srcTblF.DataBodyRange(i, colUnitName).Value
            ' 金額は単価×数量で計算し、小数点以下切り捨て
            金額 = srcTblF.DataBodyRange(i, colPrice).Value * qtyValueF
            金額 = Int(金額)
            destWs.Cells(destRow, 5).Value = 金額
            subtotal = subtotal + 金額
            destRow = destRow + 1
        End If
    Next i

    '--- 雑工事の場合、減坪金額を調べて追記 ---
    If categoryName = "雑工事" Then
        If Range("_1階減坪_金額").Value <> 0 Then
            destWs.Cells(destRow, 1).Value = "　1階減坪（" & Range("選択階数").Value & "）"
            destWs.Cells(destRow, 2).Value = Range("_1階減坪_単価").Value
            destWs.Cells(destRow, 3).Value = Range("_1階減坪_数量").Value
            destWs.Cells(destRow, 4).Value = "坪"
            金額 = Range("_1階減坪_金額").Value
            destWs.Cells(destRow, 5).Value = 金額
            subtotal = subtotal + 金額
            destRow = destRow + 1
        End If
        If Range("_23階減坪_金額").Value <> 0 Then
            destWs.Cells(destRow, 1).Value = "　2,3階減坪（" & Range("選択階数").Value & "）"
            destWs.Cells(destRow, 2).Value = Range("_23階減坪_単価").Value
            destWs.Cells(destRow, 3).Value = Range("_23階減坪_数量").Value
            destWs.Cells(destRow, 4).Value = "坪"
            金額 = Range("_23階減坪_金額").Value
            destWs.Cells(destRow, 5).Value = 金額
            subtotal = subtotal + 金額
            destRow = destRow + 1
        End If
        If Range("オーバーハング用減坪_金額").Value <> 0 Then
            destWs.Cells(destRow, 1).Value = "　オーバーハング用減坪（" & Range("選択階数").Value & "）"
            destWs.Cells(destRow, 2).Value = Range("オーバーハング用減坪_単価").Value
            destWs.Cells(destRow, 3).Value = Range("オーバーハング用減坪_数量").Value
            destWs.Cells(destRow, 4).Value = "坪"
            金額 = Range("オーバーハング用減坪_金額").Value
            destWs.Cells(destRow, 5).Value = 金額
            subtotal = subtotal + 金額
            destRow = destRow + 1
        End If
    
    End If


    '--- 小計行（商品名と同じ列に"小計"） ---
    destWs.Cells(destRow, 1).Value = "　小計"
    destWs.Cells(destRow, 5).Value = subtotal

    'MsgBox "抽出と金額計算が完了しました", vbInformation
End Sub

Sub 抽出シートクリア(ByVal destSheetName As String)
    Dim destWs As Worksheet
    Set destWs = ThisWorkbook.Sheets(destSheetName)
    destWs.Cells.ClearContents
End Sub

Sub シートの切り替え()
    Application.ScreenUpdating = False
    '全シート非表示
    Call 全シート非表示

    '必要なシートのみ表示
    Call 指定シート表示("サッシ工事")
    Call 指定シート表示("建具工事")
    Call 指定シート表示("設備工事")
    Call 指定シート表示("雑工事")

    Application.ScreenUpdating = True
End Sub

Sub 全シート非表示()
    Dim ws As Worksheet

    ' 指定以外のシートを非表示
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> SHEET_MITSUMORI And ws.Name <> SHEET_MEISAI And ws.Name <> SHEET_KIHON And ws.Name <> SHEET_SHOKEIHI Then
            ws.Visible = xlSheetHidden
        Else
            ws.Visible = xlSheetVisible
        End If
    Next ws
End Sub

Sub 指定シート表示(ByVal shName As String)
    Dim sh As String
    sh = Range(shName).Value
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(sh)
    ws.Visible = xlSheetVisible
End Sub

Sub 基本入力シートに戻る()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_KIHON)
    ws.Activate
    ws.Range("A1").Select
End Sub

Sub 見積書シートに移動()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_MITSUMORI)
    ws.Activate
    ws.Range("A1").Select
End Sub

Sub 明細書シートに移動()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_MEISAI)
    ws.Activate
    ws.Range("A1").Select
End Sub

Sub セル参照でシート移動(ByVal sheetName As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(sheetName)
    If ws.Visible = xlSheetHidden Or ws.Visible = xlSheetVeryHidden Then
        Call シートの切り替え
    End If
    ws.Activate
    ws.Range("E4").Select
End Sub

Sub サッシ工事テーブルへ移動()
    If Range("選択ブランド").Value = "" Then
        MsgBox "ブランドが選択されていません。", vbExclamation
     Exit Sub
    End If
    Call セル参照でシート移動(Range("サッシ工事").Value)
End Sub

Sub 内部建具工事テーブルへ移動()
    If Range("選択ブランド").Value = "" Then
        MsgBox "ブランドが選択されていません。", vbExclamation
     Exit Sub
    End If
    Call セル参照でシート移動(Range("建具工事").Value)
End Sub

Sub 設備工事テーブルへ移動()
    If Range("選択ブランド").Value = "" Then
        MsgBox "ブランドが選択されていません。", vbExclamation
     Exit Sub
    End If
    Call セル参照でシート移動(Range("設備工事").Value)
End Sub

Sub 雑工事テーブルへ移動()
    If Range("選択ブランド").Value = "" Then
        MsgBox "ブランドが選択されていません。", vbExclamation
     Exit Sub
    End If
    Call セル参照でシート移動(Range("雑工事").Value)
End Sub

Sub 諸経費テーブルへ移動()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(SHEET_SHOKEIHI)
    ws.Activate
    ws.Range("C6").Select
End Sub

Sub クリア()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim tbl As ListObject
    On Error Resume Next
    Set tbl = ws.ListObjects(ws.Name)
    On Error GoTo 0
    If Not tbl Is Nothing Then
        Dim colQty As Integer
        On Error Resume Next
        colQty = tbl.ListColumns("数量").Index
        On Error GoTo 0
        If colQty > 0 Then
            ' 数量列の入力範囲を一括選択してまとめて削除
            tbl.DataBodyRange.Columns(colQty).ClearContents
         End If
    End If

    Application.ScreenUpdating = True
End Sub

Sub フリー入力欄クリア
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim tblF As ListObject
    On Error Resume Next
    Set tblF = ws.ListObjects(ws.Name+"F")

    If Not tblF Is Nothing Then
        tblF.DataBodyRange.ClearContents
    End If

    ' カテゴリ列にB2セルの値を一括セット
    Dim colCategory As Integer
    On Error Resume Next
    colCategory = tblF.ListColumns("カテゴリ").Index
    On Error GoTo 0
    If colCategory > 0 Then
        tblF.DataBodyRange.Columns(colCategory).Value = ws.Range("B2").Value
    End If

    Application.ScreenUpdating = True
End Sub

Sub 見積書明細書PDF出力()

    ' 必要項目入力チェック
    If Not 必須入力チェック結果() Then
        Exit Sub
    End If

    If MsgBox("PDF形式で出力します。同じ名前のファイルがある場合は上書きされます。よろしいですか？", vbYesNo + vbQuestion, "確認") = vbNo Then
        Exit Sub
    End If

    ' まずは保存
    ThisWorkbook.Save

    Dim wsMitsumori As Worksheet, wsMeisai As Worksheet
    Dim pdfFileName As String
    Dim folderPath As String
    Dim koujiName As String, issueDate As String

    Set wsMitsumori = ThisWorkbook.Sheets(SHEET_MITSUMORI)
    Set wsMeisai = ThisWorkbook.Sheets(SHEET_MEISAI)

    ' 保存先フォルダ（必要に応じて変更）
    folderPath = ThisWorkbook.Path & "\"

    ' ファイル名用情報取得
    koujiName = Range("工事名").Value
    issueDate = Range("発行年月日").Value

    ' 日付を"yyyyMMddHHmmss"形式に
    Dim dt As String
    dt = Format(issueDate, "yyyymmdd")

    ' ファイル名作成（見積書番号は含めない）
    pdfFileName = folderPath & "マトリックス積算" & " " & koujiName & " 見積書" & dt & ".pdf"

    ' シートを配列で指定してPDF出力
    Sheets(Array(SHEET_MITSUMORI, SHEET_MEISAI)).Select
    On Error GoTo ExportError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=pdfFileName, Quality:=xlQualityStandard
    On Error GoTo 0
    GoTo ExportEnd

ExportError:
    MsgBox "PDFのエクスポートに失敗しました。同じ名前のファイルが開かれていないか確認してください。" & vbCrLf & "ファイル名: " & pdfFileName, vbExclamation
    Exit Sub

ExportEnd:

    ' 元のシートに戻る
    Call 基本入力シートに戻る

    MsgBox "PDF出力が完了しました。" & vbCrLf & pdfFileName, vbInformation
End Sub

Sub 明細書印刷範囲設定()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim 合計Row As Long
    Dim printStartRow As Long, printEndRow As Long

    Set ws = ThisWorkbook.Sheets(SHEET_MEISAI)

    ' B列の最終行取得
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' B列の最終行から上方向に「合計」を探す
    合計Row = 0
    Dim i As Long
    For i = lastRow To 2 Step -1
        If ws.Cells(i, "B").Value = "合計" Then
            合計Row = i
         Exit For
        End If
    Next i

    If 合計Row = 0 Then
        MsgBox "「合計」が見つかりません。", vbExclamation
     Exit Sub
    End If

    printStartRow = 2
    printEndRow = 合計Row + 1 ' 合計行の次の行まで

    ws.PageSetup.PrintArea = ws.Range("B" & printStartRow & ":F" & printEndRow).Address
    'MsgBox "印刷範囲をF" & printStartRow & "～F" & printEndRow & "に設定しました。", vbInformation

End Sub

Sub 入力内容をすべてクリア()
    If MsgBox("基本情報および部材リストの選択をすべてクリアします、よろしいですか？", vbYesNo + vbQuestion, "確認") = vbNo Then
     Exit Sub
    End If

    Application.ScreenUpdating = False
    Call 基本入力のE列クリア
    Call 複数シート数量クリア
    Call すべてのフリー入力欄のクリア
    Call 諸経費シートのクリア
    Call 抽出シートクリア("抽出")
    Call 指定以外のシートを非表示
    Application.ScreenUpdating = True

End Sub

Sub 複数シート数量クリア()
    Application.ScreenUpdating = False

    Dim sheetNames As Variant
    Dim i As Integer
    Dim ws As Worksheet

    ' 部材シートの数量クリア
    sheetNames = Array(SHEET_N_SASHI, SHEET_N_TATEGU, SHEET_N_SETUBI, SHEET_N_ZATSU, _
                       SHEET_B_SASHI, SHEET_B_TATEGU, SHEET_B_SETUBI, SHEET_B_ZATSU, _
                       SHEET_A_SASHI, SHEET_A_TATEGU, SHEET_A_SETUBI, SHEET_A_ZATSU)
    For i = LBound(sheetNames) To UBound(sheetNames)
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetNames(i))

        If Not ws Is Nothing Then
            On Error Resume Next
            Dim tbl As ListObject
            Set tbl = ws.ListObjects(ws.Name)
            If Not tbl Is Nothing Then
                Dim colQty As Integer
                colQty = tbl.ListColumns("数量").Index
                ' 数量列の入力範囲を一括選択してまとめて削除
                tbl.DataBodyRange.Columns(colQty).ClearContents
            End If
            On Error GoTo 0
        End If

        On Error GoTo 0
    Next i

    Application.ScreenUpdating = True
End Sub

Sub すべてのフリー入力欄のクリア()
    Application.ScreenUpdating = False

    Dim sheetNames As Variant
    Dim i As Integer
    Dim ws As Worksheet

    ' 部材シートのフリー入力欄クリア
    sheetNames = Array(SHEET_N_SASHI, SHEET_N_TATEGU, SHEET_N_SETUBI, SHEET_N_ZATSU, _
                       SHEET_B_SASHI, SHEET_B_TATEGU, SHEET_B_SETUBI, SHEET_B_ZATSU, _
                       SHEET_A_SASHI, SHEET_A_TATEGU, SHEET_A_SETUBI, SHEET_A_ZATSU)
    For i = LBound(sheetNames) To UBound(sheetNames)
        On Error Resume Next
        Set ws = ThisWorkbook.Sheets(sheetNames(i))

        If Not ws Is Nothing Then
            On Error Resume Next
            Dim tblF As ListObject
            Set tblF = ws.ListObjects(ws.Name & "F")
            If Not tblF Is Nothing Then
                tblF.DataBodyRange.ClearContents

                Dim colCategory As Integer
                colCategory = tblF.ListColumns("カテゴリ").Index
                tblF.DataBodyRange.Columns(colCategory).Value = ws.Range("B2").Value
            End If
            On Error GoTo 0
        End If

        On Error GoTo 0
    Next i

    Application.ScreenUpdating = True
End Sub


Sub 諸経費シートのクリア()
    Application.ScreenUpdating = False

    Dim ws As Worksheet

    ' 諸経費シートのクリア
    Set ws = ThisWorkbook.Sheets(SHEET_SHOKEIHI)
    ' 諸経費テーブルの「項目」「数量」「金額」列をクリア
    Dim tbl As ListObject
    Dim colItem As Integer, colQty As Integer, colAmount As Integer, colTotal As Integer
    On Error Resume Next
    Set tbl = ws.ListObjects(ws.Name)
    On Error GoTo 0

    If Not tbl Is Nothing Then
        On Error Resume Next
        colItem = tbl.ListColumns("項目").Index
        colQty = tbl.ListColumns("数量").Index
        colAmount = tbl.ListColumns("金額").Index
        On Error GoTo 0

        tbl.DataBodyRange.Columns(colItem).ClearContents
        tbl.DataBodyRange.Columns(colQty).ClearContents
        tbl.DataBodyRange.Columns(colAmount).ClearContents

    End If

    Application.ScreenUpdating = True
End Sub

Sub 基本入力のE列クリア()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim i As Long
    Set ws = ThisWorkbook.Sheets(SHEET_KIHON)
    For i = 1 To 100
        If ws.Cells(i, "B").Value = 1 Then
            ws.Cells(i, "E").ClearContents
        End If
    Next i

    For i = 1 To 100
        If ws.Cells(i, "L").Value = 1 Then
            ws.Cells(i, "N").ClearContents
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

Sub ファイルを別名保存()

    If MsgBox("ファイルを別名で保存します。同じ名前のファイルがある場合は上書きされます。よろしいですか？", vbYesNo + vbQuestion, "確認") = vbNo Then
        Exit Sub
    End If

    ' まずは保存
    ThisWorkbook.Save

    Dim folderPath As String
    Dim koujiName As String
    Dim dt As String
    Dim saveFileName As String

    ' 保存先フォルダ（現在のブックと同じ場所）
    folderPath = ThisWorkbook.Path & "\"

    ' 工事名取得
    koujiName = Range("工事名").Value
    If koujiName = "" Then
        MsgBox "工事名が入力されていません。", vbExclamation
        Exit Sub
    End If

    ' 日時取得（yyyyMMdd-HHMMSS形式）
    ' dt = Format(Now, "yyyymmdd-HHMMSS")
    dt = Format(Now, "yyyymmdd")

    ' ファイル名作成
    saveFileName = folderPath & "マトリックス積算" & " " & koujiName & " 見積書" & dt & ".xlsm"

    ' 別名で保存
    On Error GoTo SaveError
    'ThisWorkbook.SaveAs fileName:=saveFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    ThisWorkbook.SaveCopyAs fileName:=saveFileName
    On Error GoTo 0
    GoTo SaveEnd

SaveError:
    MsgBox "ファイルの保存に失敗しました。同じ名前のファイルが開かれていないか確認してください。" & vbCrLf & "ファイル名: " & saveFileName, vbExclamation
    Exit Sub

SaveEnd:

    MsgBox "ファイルを保存しました。" & vbCrLf & saveFileName, vbInformation
End Sub

Sub シート保護と非表示処理()
    Dim ws As Worksheet
    Dim pwd As String
    pwd = ThisWorkbook.Sheets(SHEET_KIHON).Range("Z10000").Value

    Application.ScreenUpdating = False

    ' 全シートをパスワードで保護
    For Each ws In ThisWorkbook.Worksheets
        ws.Protect Password:=pwd, UserInterfaceOnly:=True
    Next ws

    ' 指定以外のシートを非表示
    Call 指定以外のシートを非表示

    Application.ScreenUpdating = True
End Sub

Sub シート保護解除()
    Dim ws As Worksheet
    Dim pwd As String
    pwd = ThisWorkbook.Sheets(SHEET_KIHON).Range("Z10000").Value

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Worksheets
        ws.Unprotect Password:=pwd
    Next ws

    Application.ScreenUpdating = True
    Call 基本入力シートに戻る
    ActiveSheet.Range("E4").Select
End Sub

Sub 指定以外のシートを非表示()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> SHEET_MITSUMORI And ws.Name <> SHEET_MEISAI And ws.Name <> SHEET_KIHON And ws.Name <> SHEET_SHOKEIHI Then
            ws.Visible = xlSheetHidden
        Else
            ws.Visible = xlSheetVisible
        End If
    Next ws

    Call 基本入力シートに戻る
    ActiveSheet.Range("E4").Select
End Sub

Sub すべてのシートを表示するマクロ()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws

    Application.ScreenUpdating = True
    Call 基本入力シートに戻る
    ActiveSheet.Range("E4").Select
End Sub

Sub テーブル並び順ソート()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim sortCol As ListColumn

    Set ws = ActiveSheet
    On Error Resume Next
    Set tbl = ws.ListObjects(ws.Name)
    On Error GoTo 0

    If tbl Is Nothing Then
        MsgBox "シート名と同じテーブルが見つかりません。", vbExclamation
        Exit Sub
    End If

    Set sortCol = Nothing
    On Error Resume Next
    Set sortCol = tbl.ListColumns("並び順")
    On Error GoTo 0

    If sortCol Is Nothing Then
        MsgBox "「並び順」列が見つかりません。", vbExclamation
        Exit Sub
    End If

    With tbl.Sort
        .SortFields.Clear
        .SortFields.Add key:=sortCol.DataBodyRange, Order:=xlAscending
        .Header = xlYes
        .Apply
    End With

    Application.ScreenUpdating = True
    MsgBox "並び順でソートが完了しました。", vbInformation
End Sub

Function 必須入力チェック結果() As Boolean
    Dim ws As Worksheet
    Dim i As Long
    Set ws = ThisWorkbook.Sheets(SHEET_KIHON)

    For i = 1 To 100
        If ws.Cells(i, "F").Value = "※" Then
            If ws.Cells(i, "E").Value = "" Then
                ws.Activate
                ws.Cells(i, "E").Select
                MsgBox "「" & ws.Cells(i, "C").Value & "」が未入力です。", vbExclamation
                必須入力チェック結果 = False
                Exit Function
            End If
        End If
    Next i
    必須入力チェック結果 = True
End Function

Sub パターン別一括設定_ガス仕様()
    Call パターン別一括設定("ガス仕様")
End Sub

Sub パターン別一括設定_電気仕様()
    Call パターン別一括設定("電気仕様")
End Sub

Sub パターン別一括設定_ZEH仕様()
    Call パターン別一括設定("ZEH仕様")
End Sub

Sub パターン別一括設定(ByVal pattern As String)
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim colPattern As Integer, colQty As Integer
    Dim r As Long

    Set ws = ActiveSheet
    On Error Resume Next
    Set tbl = ws.ListObjects(ws.Name)
    On Error GoTo 0
    If tbl Is Nothing Then
        MsgBox "シート名と同じテーブルが見つかりません。", vbExclamation
        Exit Sub
    End If

    colPattern = 0
    colQty = 0
    On Error Resume Next
    colPattern = tbl.ListColumns(pattern).Index
    colQty = tbl.ListColumns("数量").Index
    On Error GoTo 0

    If colPattern = 0 Or colQty = 0 Then
        MsgBox "「数量」列または「" & pattern & "」列が見つかりません。", vbExclamation
        Exit Sub
    End If

    tbl.DataBodyRange.Columns(colQty).Value = tbl.DataBodyRange.Columns(colPattern).Value
    
    Application.ScreenUpdating = True
End Sub

Sub 商品名列範囲を非表示()
    Application.ScreenUpdating = False

    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim colProduct As Integer
    Dim lastRow As Long, freeItemRow As Long
    Dim i As Long

    Set ws = ActiveSheet
    On Error Resume Next
    Set tbl = ws.ListObjects(ws.Name)
    On Error GoTo 0
    If tbl Is Nothing Then
        MsgBox "シート名と同じテーブルが見つかりません。", vbExclamation
        Exit Sub
    End If

    On Error Resume Next
    colProduct = tbl.ListColumns("商品名").Index
    On Error GoTo 0
    If colProduct = 0 Then
        MsgBox "「商品名」列が見つかりません。", vbExclamation
        Exit Sub
    End If

    On Error Resume Next
    ws.Rows.Hidden = False
    On Error GoTo 0

    lastRow = tbl.DataBodyRange.Rows.Count + tbl.HeaderRowRange.Row + 1
    freeItemRow = 0

    For i = tbl.HeaderRowRange.Row To ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
        If ws.Cells(i, "B").Value = "フリー項目欄" Then
            freeItemRow = i
            Exit For
        End If
    Next i

    If freeItemRow = 0 Then
        MsgBox "「フリー項目欄」が見つかりません。", vbExclamation
        Exit Sub
    End If

    If lastRow + 1 < freeItemRow - 1 Then
        ws.Rows((lastRow + 1) & ":" & (freeItemRow - 2)).Hidden = True
    End If

    Application.ScreenUpdating = True
        
    ws.Cells(freeItemRow + 2, "B").Select

    
End Sub

Sub すべてのシートボタン文字色一括変更()
    Dim ws As Worksheet
    Dim shp As Shape
    Dim btn As Object
    Dim targetColor As Long
    targetColor = RGB(0, 0, 0) ' 赤色（例）

    For Each ws In ThisWorkbook.Worksheets
        ' Formコントロールボタン
        For Each shp In ws.Shapes
            If shp.Type = msoFormControl Then
                If shp.FormControlType = xlButtonControl Then
                    shp.TextFrame.Characters.Font.Color = targetColor
                End If
            End If
        Next shp
        ' ActiveXコントロールボタン
        For Each btn In ws.OLEObjects
            If TypeName(btn.Object) = "CommandButton" Then
                btn.Object.ForeColor = targetColor
            End If
        Next btn
    Next ws
End Sub