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

・各種日本語入力ソフトの辞書解説 ・ちょっと楽になるExcel VBA集

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

f:id:dz_dzone:20170814233145j:plain

ExcelのVBAマクロでオートシェイプを描画する場合の基礎知識を紹介します。

座標系

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

ポイント単位とは? (2018.12.17追記)

ポイントとはExcel(Office)内で使われる独自の単位で、ピクセルのようなものですがピクセルとは異なります。またフォントのサイズのことでもありません。ポイントとピクセルは以下の式が当てはまります。

1ピクセル=0.75ポイント  ( 1ポイント≒1.3334ピクセル)

座標系(図解)

f:id:dz_dzone:20181218104930j:plain

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

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

  • Selection.Left = X座標
  • Selection.Top = Y座標
  • Selection.Width = 幅のポイント値
  • Selection.Height = 高さのポイント値

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

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

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

開始点(X1, Y1) , 終了点(X2, Y2) を指定するもの

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

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

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

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

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

その他

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

サンプル

工程表・ガントチャートのような直線を描画する

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

  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

選択範囲の中心に位置する最大の円を描画する

Sub DrawCircle()
  ' ** 選択範囲の中央に位置する最大の真円を描画する **
  Dim L, T, W, H As Variant
  Dim L2, T2, W2, H2 As Variant
    
  ' **選択範囲の基礎情報を取得
  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

以上。

お詫びと訂正

  • 2018.12.17:当初、シェイプの座標の単位を「ピクセル(ポイント)」と説明していましたが、ピクセルとポイントは別の単位で、正しくは「ポイント」でした。相関関係を説明の上、訂正してお詫び致します
  • 2018.12.17:当初、Range.Top, Left, Width, Heightのデータ型を「単精度浮動小数点数型(Single型)」と説明していましたが、正しくは「Variant型」でした。訂正してお詫び致します