【ExcelVBA】シェイプをつくる

Excel, VBA, シェイプ

はじめに

今日はVBAを使ってシェイプを作っていこうかなと思います。
マウスの右クリック操作でスケジュール線を引くようなものをイメージして作っていきます。

設計図

動作のイメージはこんな感じ。

  • マウスでセルの範囲を選択
  • マウスを右クリックすると選択された位置に線を引く

処理の流れはこんなイメージでいこうと思います。

  • 右クリックしたら処理開始
  • 選択されたセルの範囲をGet！
  • セルの範囲の左側と右側の位置を取得
  • セルの真ん中に線を引くために、行の中央の位置を取得
  • 取得した左側～右側の位置、行の中央の位置に直線を引く

直線を引く

直線を引くには以下のコードを実行すればOK。
Object.Shapes..AddLine (BeginX, BeginY, EndX, EndY)

この引数は直線を引くための始点と終点の座標(X,Y)です。この引数にセットするプログラムを書けばよいわけです。
始点と終点の座標のイメージは下図の通り。
BeginY と EndYを同じ値にすれば水平な直線を引くことができます。

右クリックされたら処理開始

右クリックされたら処理開始するプログラムを書いていきます。
シートを右クリックされたというイベントを拾う必要があるので、VBA該当のシートのプログラムを開きます。

VBE(Visual Basic Editor)のSheet1をダブルクリック

WorksheetのBeforeRightClickを選択します。
ここにプログラムを書いておくと、Sheet1が右クリックされたというイベントを拾って処理が開始されます。

選択されたセルの範囲をGet！

選択されたセルの範囲は、Targetという名前の引数です。

始点（左側）の位置（BeginX）の取得

左側のセルの位置はTarget.Leftで取得できます。列 A の左端から範囲の左端 までの距離をポイントで取得します。

     Dim SglBeginX       As Single '選択された位置の左側
    
    '◆◆◆　始点（左側）の位置（BeginX）の取得
    SglBeginX = Target.Left

終点（右側）の位置（EndX）の取得

右側の位置を直接取得できるものがないので、左側の位置と選択された幅を足したものを右側の位置とします。
選択された幅はTarget.Widthで取得できます。

    Dim SglEndX         As Single '選択された位置の右側
    
    
    '◆◆◆　終点（右側）の位置（EndX）の取得
    SglEndX = SglBeginX + Target.Width

高さの位置（BeginYとEndY）の取得

選択された上の高さ位置はTarget.Topから取得しますが、今回はセルの行の中央に線を引きたいので選択されたセルの高さTarget.Heightを使います。

    Dim SglBeginEndY    As Single '直線を引く高さ位置
    
    '◆◆◆　高さの位置（BeginYとEndY）の取得
    SglBeginEndY = Target.Top + (Target.Height / 2)

直線を引く

それぞれ求めた始点X,Yと終点X,Yを Object.Shapes..AddLine にセットすれば直線を引くことができます。

    '◆◆◆　シェイプ（直線）を引く
    Sheet1.Shapes.AddLine SglBeginX, SglBeginEndY, SglEndX, SglBeginEndY

矢印、色、太さを変える

作成したシェイプをあれこれ操作するためには、先ほどのコードを少し手直しする必要があります。
AddLineに()を付けて引数を渡すと、作成したシェイプのオブジェクト（実体）を戻り値として返してくるので、それを受け取るようにします。
またオブジェクトを受け取る場合はSetステートメントを使います。

    Dim ObjMyShape      As Shape  'シェイプオブジェクトを受け取る変数

    
    '◆◆◆　シェイプ（直線）を引く
    Set ObjMyShape = Sheet1.Shapes.AddLine(SglBeginX, SglBeginEndY, SglEndX, SglBeginEndY)

シェイプを矢印に変更する

線の両脇を矢印に変更するには、オブジェクトを受け取った変数を使って設定していきます。

    '◆◆◆　シェイプの両端を矢印にする
    ObjMyShape.Line.BeginArrowheadStyle = msoArrowheadTriangle
    ObjMyShape.Line.EndArrowheadStyle = msoArrowheadTriangle

細かい説明は省略。ヘルプなどで確認してみて。

シェイプの色と太さを変える

    '◆◆◆　シェイプの色と太さを変える
    ObjMyShape.Line.ForeColor.RGB = vbRed       '色を変更　赤色に
    ObjMyShape.Line.Weight = 3                  '太さを３ポイントに

最後に

本来の動作の右クリックをキャンセルする

いまの状態でマクロを実行すると、線を引いた後に右クリックのメニュー（下図）が表示されちゃいます。
ですので、この動作をキャンセルする必要があります。

    '◆◆◆　右クリックの動作をキャンセルする
    Cancel = True

これでセルを選択して右クリックすると矢印付きの直線が出来上がると思います。