日本語入力ソフトとVBAの覚え書き

・各種日本語入力ソフトの辞書解説 ・ちょっと楽になるWord/Excel VBA集 ・ボーダーブレイク用語辞書

VBAマクロでオートシェイプを描画するときの基礎知識


f:id:dz_dzone:20170814233145j:plain

VBAマクロでオートシェイプを描画する場合、

座標系

オートシェイプの座標系は画面の左上を原点として右方向がX軸、下方向がY軸の、値はピクセル(ポイント)単位のものになります。

f:id:dz_dzone:20171113133254j:plain

選択範囲から得られる座標値

描画をするにあたり、その位置を決定するために、選択範囲からいくつかの値が得られるようになっています。上図のように範囲選択をしたときに、

  • Selection.Left = X座標
  • Selection.Top = Y座標
  • Selection.Width = 幅のピクセル値
  • Selection.Height = 高さのピクセル値

の値が得られます。これらの値を計算することで、右上、左下、右下の座標やその他の座標を得ることも可能です。なお、値は単精度浮動小数点数型(Single型)になります。

  Dim T, L, W, H As Single
  
  With Selection
    T = .Top
    L = .Left
    W = .Width
    H = .Height
  End With

オートシェイプを描画するメソッド

開始点(X, Y) , 終了点(X, Y) を指定するもの

  • AddLine : 直線を描画する
  • AddConnector : コネクタを描画する

左上隅の座標値(X, Y) と 幅(Width) と 高さ(Height) を指定するもの

  • AddShape : いろいろなオートシェイプを描画する (汎用)
  • AddCallout : 輪郭なしの吹き出しを描画する
  • AddTextBox : テキストボックスを描画する

座標値の配列を指定するもの

  • AddPlyLine : ポリラインを描画する
  • AddCurve:ベジェ曲線(スプライン曲線)を描画する

その他

  • BuildFreeform : フリーフォームを描画する

サンプル

サンプル1 : ガントチャートのような直線を描画する

Sub AddLineSample()
  Dim T, L, W, H As Single
  Dim X1, Y1, X2, Y2 As Single

  With Selection
    T = .Top
    L = .Left
    W = .Width
    H = .Height
  End With
  
  X1 = L
  Y1 = T + H / 2
  X2 = L + W
  Y2 = T + H / 2

  With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2)
    With .Line
      .ForeColor.RGB = RGB(255, 0, 0)
      .Weight = 4
      .DashStyle = msoLineSolid
    End With
  End With
End Sub

サンプルコードはやや冗長に書いていますが、この書き方がオートシェイプを追加するときの基本的な書き方になります。

f:id:dz_dzone:20171113153504j:plain

f:id:dz_dzone:20171113153522j:plain

サンプル2 : 選択範囲の中心に位置する最大の円を描画する

Sub DrawCircle()
  ' ** 選択範囲の中央に位置する最大の真円を描画する **
  Dim L, T, W, H As Single
  Dim L2, T2, W2, H2 As Single
    
  ' **選択範囲の基礎情報を取得
  With Selection
    L = .Left
    T = .Top
    W = .Width
    H = .Height
  End With

  ' **描画開始位置の設定
  If W > H Then
    L2 = L + (W - H) / 2
    T2 = T
  Else
    L2 = L
    T2 = T + (H - W) / 2
  End If

  ' **幅と高さの設定
  If W > H Then
    W2 = H
    H2 = H
  Else
    W2 = W
    H2 = W
  End If

  With ActiveSheet.Shapes.AddShape(msoShapeOval, L2, T2, W2, H2)
    With .Line
      .ForeColor.RGB = RGB(0, 0, 0)
      .Weight = 1
    End With
    With .Fill
      .ForeColor.RGB = RGB(255, 0, 0)
      .Patterned (msoPatternLightUpwardDiagonal)
    End With
  End With
End Sub

f:id:dz_dzone:20171117094023j:plain

f:id:dz_dzone:20171117094034j:plain

以上。

にほんブログ村 IT技術ブログ VBAへ←記事を気に入って頂けたらポチッとしてもらえると励みになります。