[Excel VBA] 工程表の作成 -VBAによるShapeの描画- (1)

仕事をしていると必ず必要になるのが工程表ですが、これは専らExcelで作られることが多いです。かくいう自分も自分のニーズに合わせた工程表を作って管理をしています。工程表で予定と実績を示すラインはオートシェイプで描画していますが、これまでは手入力のオートシェイプでした。または元からあるラインをコピーして伸縮して使っていました。

これをVBAで自動描画出来ないかと考え、Shapeの描画について調べてみました。

最初にラインを引くメソッドをヘルプで検索してみました。

expression.AddLine(BeginX, Beginy, EndX, EndY)

BeginX, BeginY : 開始点のX,Y座標 As Single
EndX, EndY : 終了点のX,Y座標 As Single

それでは、狙った場所にラインを引くにはどうしたらよいでしょうか。狙った場所は選択範囲とすれば何かプロパティ値が取得できるような気がします。そこで調べてみると、以下の図のようなプロパティ値が取得できることが分かりました。

選択範囲については、まず左上の座標値（ピクセル単位）が取得できます。さらに幅と高さのピクセル数およびセル数が分かります。また、左上と右下のセルは特定でき、行番号および列番号が取得できます。

ラインを引く場合はピクセル座標値での指定なので、これらから計算させれば引くことが可能です。

それではコードです。ボタンを配置しておき、クリックでラインを引くようにします。

Private Sub CommandButton2_Click()

    Dim SentakuTop As Single      ' 選択範囲左上座標値 Y
    Dim SentakuLeft As Single     ' 選択範囲左上座標値 X
    Dim SentakuWidth As Single    ' 選択範囲幅
    Dim SentakuHeight As Single   ' 選択範囲高さ
    Dim SentakuAddress As String  ' 選択範囲アドレス
    Dim X0, Y0, X1, Y1 As Variant

    ' 選択範囲の取得（相対指定のExcel形式：ex. A1:A9）
    SentakuAddress = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False)

    ' 選択範囲左上の座標値および選択幅、選択高さを取得（ピクセル単位）
    With ActiveSheet.Range(SentakuAddress)
        SentakuTop = .Top
        SentakuLeft = .Left
        SentakuWidth = .Width
        SentakuHeight = .Height
    End With
            
    ' 工数ラインの開始座標、終了座標を計算
    X0 = SentakuLeft
    Y0 = SentakuTop + SentakuHeight / 2
    X1 = SentakuLeft + SentakuWidth
    Y1 = Y0
    
    ' 工数ラインをプロットする
    With ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1).Line
        .ForeColor.RGB = RGB(0, 0, 255)
        .Weight = 4
    End With

End Sub

選択範囲の取得は絶対指定でも良さそうです。

ちなみにLineFormatのプロパティは、オブジェクトブラウザで見ると以下のようになっています。