2019年5月7日火曜日

【マクロ】セルの上下に余白を持たせ表を見やすくする

Sub NiceRowheight()
'余白設定
Const buf = 10
Application.ScreenUpdating = False
'とりあえず選択範囲の行高さをAutoFitする
Selection.Rows.AutoFit
'選択範囲が広すぎる時のために、データ最終行を獲得しておく
maxrow = Range("A1").SpecialCells(xlLastCell).Row
'その後、微妙に行高さを広げる。(1列目のみ処理)
For Each hoge In Selection.Columns(1).Cells
    hoge.RowHeight = hoge.RowHeight + buf
    '経過観察&終了判定
    i = i + 1
    If i Mod 2000 = 0 Then
        '終了判定(データの最終行を越えてたら終了する。)
        If hoge.Row > maxrow Then Exit For
        Application.StatusBar = i
        DoEvents
    End If
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

0 件のコメント:

コメントを投稿