So-net無料ブログ作成
検索選択

[VBA]罫線描画&罫線消去 [Programming ExcelVBA]

[はじめに]
Excelマクロで罫線描画、罫線消去を実装することがよくあります。
 『マクロの記録』で簡単に作れますが、汎用性がないので関数化しました。
 機能は単純に、セル範囲に罫線(外枠、内側の境界線)を描画するだけです。
 とりあえず、備忘録として載せておきます。

[ソース]
コードのコピー
Option Explicit

''' <summary>
''' 指定したセル範囲に罫線を描画する。(外枠、内側の境界線)
''' </summary>
''' <param name="targetRange">対象セル範囲</param>
''' <remarks></remarks>
Public Sub DrawLine(ByVal targetRange As Range)
    With targetRange
    
        '個々のセルの右上がり斜線
        .Borders(xlDiagonalUp).LineStyle = xlNone
        
        '個々のセルの右下がり斜線
        .Borders(xlDiagonalDown).LineStyle = xlNone
        
        'セル範囲の最上端
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        'セル範囲の最下端
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        'セル範囲の最左端
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        'セル範囲の最右端
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        If .Cells(1).Row < .Cells(.Count).Row Then
            'セル範囲の上下端以外の境界線
            '【注意(Excel2003以前のみ】
            ' セル範囲が複数行にわたる場合のみ処理します。
            ' 単数行の場合に処理するとエラーになることがあります。
            With .Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If

        If .Cells(1).Column < .Cells(.Count).Column Then
            'セル範囲の左右端以外の境界線
            '【注意(Excel2003以前のみ】
            ' セル範囲が複数列にわたる場合のみ処理します。
            ' 単数列の場合に処理するとエラーになることがあります。
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End If

    End With

End Sub

''' <summary>
''' 指定したセル範囲の罫線を消去する。(外枠、内側の境界線)
''' </summary>
''' <param name="targetRange">対象セル範囲</param>
''' <remarks></remarks>
Public Sub EraseLine(ByVal targetRange As Range)
    
    With targetRange
        
        '個々のセルの右上がり斜線
        .Borders(xlDiagonalUp).LineStyle = xlNone
        
        '個々のセルの右下がり斜線
        .Borders(xlDiagonalDown).LineStyle = xlNone
        
        'セル範囲の最上端
        .Borders(xlEdgeTop).LineStyle = xlNone
        
        'セル範囲の最下端
        .Borders(xlEdgeBottom).LineStyle = xlNone
        
        'セル範囲の最左端
        .Borders(xlEdgeLeft).LineStyle = xlNone
        
        'セル範囲の最右端
        .Borders(xlEdgeRight).LineStyle = xlNone
        
        If .Cells(1).Row < .Cells(.Count).Row Then
            'セル範囲の上下端以外の境界線
            '【注意(Excel2003以前のみ)】
            ' セル範囲が複数行にわたる場合のみ処理します。
            ' 単数行の場合に処理するとエラーになります。
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End If
        
        If .Cells(1).Column < .Cells(.Count).Column Then
            'セル範囲の左右端以外の境界線
            '【注意(Excel2003以前のみ)】
            ' セル範囲が複数列にわたる場合のみ処理します。
            ' 単数列の場合に処理するとエラーになることがあります。
            .Borders(xlInsideVertical).LineStyle = xlNone
        End If
        
    End With

End Sub
[ExcelVBA]罫線の描画&消去

コードのコピー
Private Sub CommandButton1_Click()
    '罫線描画
    Call DrawLine(Selection)
End Sub

Private Sub CommandButton2_Click()
    '罫線消去
    Call EraseLine(Selection)
End Sub
[ExcelVBA]呼び出し例

メッセージを送る

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。