Excelシート内のアクティブセル領域にマクロでスタイルを自動適用する


Excelシート内のアクティブセル領域にマクロでスタイルを自動適用します。

Sub 表デザイン自動適用()
'#########################################################
'# マクロ名   :
'# 機能       :
'# 作成者     :
'# 作成日     :
'# 変更履歴   :
'# 変更日     :
'#########################################################
'変数を宣言
    Dim start_row As Integer        '選択範囲の開始行を宣言
    Dim end_row As Integer          '選択範囲の終了行を宣言
    Dim start_column As Integer     '選択範囲の開始列を宣言
    Dim end_column As Integer       '選択範囲の終了列を宣言

'表を選択
    ActiveCell.CurrentRegion.Select 'アクティブセルの表範囲を選択

'変数に表選択範囲を代入
    start_row = Selection(1).Row
    end_row = Selection(Selection.Count).Row
    start_column = Selection(1).Column
    end_column = Selection(Selection.Count).Column

'表に罫線を描画
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    With Selection.Borders(xlEdgeLeft)      '表の左部に細い線
        .LineStyle = xlContinuous
    End With

    With Selection.Borders(xlEdgeTop)       '表の上部に細い線
        .LineStyle = xlContinuous
    End With

    With Selection.Borders(xlEdgeBottom)    '表の下部に細い線
        .LineStyle = xlContinuous
    End With

    With Selection.Borders(xlEdgeRight)     '表の右部に細い線
        .LineStyle = xlContinuous
    End With

    With Selection.Borders(xlInsideVertical)    '表の内縦に細い線
        .LineStyle = xlContinuous
    End With

    With Selection.Borders(xlInsideHorizontal)  '表の内横に細い線
        .LineStyle = xlContinuous
        .Weight = xlHairline
    End With

    Range(Cells(start_row, start_column), Cells(start_row, end_column)).Select  '表範囲のヘッダを選択

    With Selection.Borders(xlEdgeBottom)                                        '表範囲のヘッダの下部線を二重線
        .LineStyle = xlDouble
        .Weight = xlThick
    End With

    With Selection.Interior                                                     '選択範囲のヘッダを緑色に変更
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.399975585192419
    End With

'表の横幅を自動調整
    Range(Cells(start_row, start_column), Cells(end_row, end_column)).EntireColumn.AutoFit

End Sub