ExcelVBAでQA表テンプレートを自動作成

作るもの

こんな感じのQA表テンプレートを作るためのマクロを実装

QA表シート

pulldown用のシート

マクロコード抜粋

Sub QA表作成()

    Dim NewSheet As Worksheet
    Dim ActiveSheetIndex As Long

    ' アクティブシートのインデックスを取得
    ActiveSheetIndex = ActiveSheet.Index
    ' 新しいシートを作成し、アクティブシートの次に配置
    Set NewSheet = Sheets.Add(After:=Sheets(ActiveSheetIndex))
    ' シート名を変更
    NewSheet.Name = "QA表"

    ' ヘッダー行を設定
    Range("B2").Value = "No"
    Range("C2").Value = "Status"
    Range("D2").Value = "Q"
    Range("E2").Value = "Q補足"
    Range("F2").Value = "A"

    ' テーブルを作成
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$2:$F$17"), , xlYes).Name = "テーブル1"

    ' テーブルの罫線を設定
    With Range("B2:F17").Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

     ' セルの上揃えと左揃えを設定
    With ActiveSheet.ListObjects(1).DataBodyRange
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
    End With

    ' ヘッダー行の背景色を設定
    With ActiveSheet.ListObjects(1).HeaderRowRange.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
    End With
    
    With ActiveSheet.ListObjects(1).HeaderRowRange.Font
        .Color = RGB(0, 0, 0) ' 黒色に設定
    End With

    With ActiveSheet.ListObjects(1)
        .TableStyle = "TableStyleLight1" ' テーブルスタイルをシンプルなものに変更
        .ShowTableStyleRowStripes = False ' 行のストライプを削除
    End With

    ' Q, Q補足, A列の幅を設定
    Columns("D:F").ColumnWidth = 30.58

    ' 新しいシートを作成し、アクティブシートの次に配置
    Set NewSheet = Sheets.Add(After:=Sheets("QA表"))
    ' シート名を変更
    NewSheet.Name = "_pulldown_"

    ' プルダウン用の値を設定
    Range("A1").Value = "Open"
    Range("A2").Value = "Closed"

    ' QA表シートに戻る
    Sheets("QA表").Select

    ' Status列のデータ検証を設定
    With ActiveSheet.ListObjects(1).ListColumns("Status").DataBodyRange.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=_pulldown_!$A$1:$A$2"
        .IgnoreBlank = True
        .InCellDropdown = True
    End With

    ' Status列の条件付き書式を設定（Open）
    With ActiveSheet.ListObjects(1).ListColumns("Status").DataBodyRange.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Open""")
        .Font.Color = -16383844
        .Interior.Color = 13551615
    End With

    ' Status列の条件付き書式を設定（Closed）
    With ActiveSheet.ListObjects(1).ListColumns("Status").DataBodyRange.FormatConditions.Add(Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""Closed""")
        .Interior.ThemeColor = xlThemeColorDark1
        .Interior.TintAndShade = -0.249946592608417
    End With

    Range("A1").Select
End Sub

感想

マクロの自動記録 + 手直しでできた。
わからないところはChatGPT先生にきいた。

改訂履歴

• 2023/03/19: コードのリファクタリングとコメント追加
• 2023/03/20: 表のセルの上揃えと左揃えを追加