[Excel VBA]MakeWhiteGridSheet～選択中のシートを白いExcel方眼紙(18px * 18px)に～

5622 ワード
ExcelVBA Excel方眼紙 ExcelVBA テキストリンク

【2018/12/16 更新】
nukie_53さんから頂いた補正ソースを併記させて頂きました。
どうもありがとうございます！

選択中のシートを白いExcel方眼紙(18px * 18px)にするプロシージャです。

＜実行前＞

＜実行後＞

MakeWhiteGridSheet.bas
'***********************************************************
'[summary]make a white grid sheet (18px * 18px)
'[return]-
'[argument]-
'[detail]
'   1)select all cells
'   2)change cell size to 18px * 18px
'   3)fill with white
'[remarks]
'[create date]2018/12/15
'[update date]
'***********************************************************
Sub MakeWhiteGridSheet()
    ''select all cells
    Cells.Select
    ''change cell size to 18px * 18px
    Selection.ColumnWidth = 0.72
    Selection.RowHeight = 6.8
    ''fill with white
    Selection.Interior.ThemeColor = xlThemeColorDark1
    Selection(1).Select
End Sub

【2018/12/16 更新】
nukie_53さんより以下のコメントおよび補正ソースを頂きました！
ありがとうございます！

ColumnWidthは「セルのスタイル」の「標準」に設定されているフォントに依存し、「そのフォント○文字分の幅」を指定します。
そのため、現在の指定方法ではフォントが変更されたときに追従できないことになります。
そのあたりも含めてざっくり補正をかけると以下のようになるでしょう。

MakeWhiteGridSheet2.bas
Sub MakeWhiteGridSheet2()
    Const GridSizePx = 18
    Const Pt_per_Px = 72 / 96 '環境依存
    Const GridSizePt = Pt_per_Px * GridSizePx

    With Cells
        Dim a1Cell As Excel.Range
        Set a1Cell = .Item(1)

        ''change cell size to 18px * 18px
        .RowHeight = GridSizePt

        Dim i As Long
        For i = 1 To 2 '誤差のため1回では指定した数値ぴったりにならない事がある
            Dim charWidth_per_Pt As Double
            charWidth_per_Pt = a1Cell.ColumnWidth / a1Cell.Width
            .ColumnWidth = charWidth_per_Pt * GridSizePt
        Next i


        ''fill with white
        .Interior.ThemeColor = XlThemeColor.xlThemeColorDark1
    End With 'Cells
    a1Cell.Select
End Sub

恥ずかしながら全く知らなかったので勉強になりました！
ありがとうございました！！