斜線の位置をセルの角に合わせるマクロ

中級VBA

はじめに

 図のように、休日の行に斜線を引くような場合、手作業ですとセルの角に位置をわせるのが大変です。
VBAを使えばオートシェイプ(斜線)は、始点と終点を数値で指定できセルの角の位置を取得できるので、簡単に位置調整が可能です。

セルの位置を取得する

 セルの位置を示すプロパティは、左上が基準となっており、横方向の Left と、縦方向の Top で取得できます。
更にセルの幅は Width、高さは Height で取得できます。

 左上以外の頂点に関しては、これら4つの値から計算で求める必要があります。
右下の頂点は、横方向が Left + Width、縦方向が Top + Height で求める事ができます。

斜線(コネクタ)を引くマクロ

 斜線を引くには、AddConnectorメソッドを使います。構文は以下のようになります。

  Shapes.AddConnector (Type、 BeginX、 BeginY、 EndX、 EndY)

 Typeには、コネクターの種類を指定します。
他は、始点の x,y の位置。終点の x,y の位置をそれぞれ単精度浮動小数点型 (Single)で指定します。
今回は、始点、終点にセルの頂点の座標を指定します。

斜線をセルの角に合わせるマクロ

 斜線は図のように左下から右上に引く場合と、左上から右下に引き場合があります。今回は2つのケースをそれぞれプロシージャで用意して呼び出すようにしてみます。

'セルの左下から右上に斜線を引く
Sub myAddConnectorLBRT(rng1 As Range, rng2 As Range)
    Dim mRight As Single, mBottom As Single
    mRight = rng2.Left + rng2.Width
    mBottom = rng1.Top + rng1.Height
    With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, rng1.Left, mBottom, mRight, rng2.Top)
        .Line.ForeColor.RGB = RGB(0, 0, 0)  '線の色を黒に指定
    End With
End Sub

コード解説

 このコードでは、第一引数に始点となるセル。第二引数に終点をなるセルを指定します。
最初にセルの左下から右上に斜線を引くために、始点の下(mBottom)と、終点の右(mRight)を取得します。

 次に、ActiveSheet.Shapes.AddConnector として斜線(コネクタ)を追加します。第一引数に関しては、通常の線コネクタである msoConnectorStraight を指定しています。その他の引数は始点と終点の座標をセルのプロパティから取得します。

 尚、Shapes.AddConnectorシート指定が無いとエラーとなりますので注意してください。

 ActiveSheet.Shapes.AddConnector は、戻り値として生成した線コネクタ(シェイプ)を返します。
上記のプログラムは、With を使ってこれを受け取り、Line.ForeColor.RGB で線の色を黒にしています。
その他の線のプロパティを指定したい場合は、この部分に追加すればOKです。

セルの左上から右下に斜線を引くプログラムは、以下のようになります。始点と終点の指定以外は同じなので解説は省略します。

'セルの左上から右下に斜線を引く
Sub myAddConnectorLTRB(rng1 As Range, rng2 As Range)
    Dim mLeft As Single, mBottom As Single
    mRight = rng2.Left + rng2.Width
    mBottom = rng2.Top + rng2.Height
    With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, rng1.Left, rng1.Top, mRight, mBottom)
        .Line.ForeColor.RGB = RGB(0, 0, 0)
    End With
End Sub

曜日が土日の時に斜線を引くマクロ

 上記のプロシージャを利用して、図のように土日に斜線を引くプログラムを書いてみます。

Sub macro()
    '図形を全て削除
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Delete

    Dim i As Long
    For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
        If Cells(i, "C").Text = "土" Or Cells(i, "C").Text = "日" Then
            Call myAddConnectorLBRT(Cells(i, "D"), Cells(i, "G"))
        End If
    Next i
End Sub

 このプログラムでは、C列の値を確認して、土日であれば、D列からG列まで斜線を引くようにしています。
冒頭では、これまである図形を削除していますが、これは以前の斜線をクリアするためです。

 尚、今回のプログラムでは、アクティブシートのみに対応しています。シート指定したい場合は、実行したいシートを Select してアクティブシートにするか、プログラムを改造(myAddConnectorLBRTも)が必要になりますので注意してください。

タイトルとURLをコピーしました