図形シェイプをセルの中心に配置

中級VBA

図形シェイプをセルの中心に配置させる

 図形シェイプは、Left, Top, Width, Height の4つのプロパティ値で配置できます。
 Left = 0
 Top = 0
 これは、ウインドウの左上になり、セルの A1 の右上と同じです。
 
 図形シェイプをセルの位置に合わせて配置したい場合、まず、セルがウインドウのどの位置にあるか見つける必要があります。
 各セル(Rangeオブジェクト)も同じように Left, Top, Width, Height のプロパティ値がありますので、そこから計算すれば、図形シェイプを正確な位置に配置できます。

セルの位置を取得

 試しにB2の位置を取得してみます。

Sub testCode1()
    'セルの位置を得る
    With Range("B2")
    
    Debug.Print "Left = " & .Left
    Debug.Print "Top = " & .Top
    Debug.Print "Width = " & .Width
    Debug.Print "Height = " & .Height
    
    End With
End Sub

 このコードでは With ステートメントで記述を省略しています。
 省略しない場合は、以下のように書きます。 
 Debug.Print “Top = ” & Range(“B2”).Top

 結果は次のようになりました。

 Left = 48
 Top = 24
 Width = 48
 Height = 24

 Left, Top, は位置の値。
 Width, Height は長さの値になります。

図形シェイプの位置情報を得る

 図形シェイプは位置情報以外にもたくさんのプロパティ値を持っています。
 配置したい図形シェイプを作る際に「マクロの記録」を使うと、位置以外のプロパティ値もまとめて取得できるので便利です。
 まずは単純な図形シェイプを追加してみましょう。

図形シェイプの追加

 「マクロの記録」を開始してから、B2の左上からドラッグを開始して図形シェイプを追加してみます。
 図形を追加したら「マクロの記録」を終了します。
 

Sub Macro6()
'
' Macro6 Macro
'

'
    ActiveSheet.Shapes.AddShape(msoShapeOval, 48.4615748031, 24.2307874016, _
        47.6922834646, 22.3076377953).Select
End Sub

このようになりました。
AddShapeメソッドで、5つの引数で実行しています。
引数は、図形シェイプの種類, Left, Top, Width, Height の値を指定します。
数値が先程のB2の値と近い位置になっているのがわかると思います。

一旦、表示された図形を削除して、
以下のようにプログラムを変更してみてください。

Sub Macro6()
'
' Macro6 Macro
'

'
    ActiveSheet.Shapes.AddShape(msoShapeOval, 48, 24, _
        48, 24).Select
End Sub

今度はB2セルにぴったりと収まって配置されました。

既にある図形シェイプを移動

 再び「マクロの記録」を使いましょう。
 先の例で配置した図形シェイプを右に移動する様子を「マクロの記録」で再現させてみます。

Sub Macro7()
'
' Macro7 Macro
'

'
    ActiveSheet.Shapes.Range(Array("Oval 5")).Select
    Selection.ShapeRange.IncrementLeft 24.6153543307
End Sub

 ここでは少々厄介なコードを出力してきましたが、解説しておきます。
 まず、「Oval 5」は今回の図形シェイプの名前になります。
 ご自身の結果とは異なる場合がありますので読み替えてください。
 1行目は単純に、図形シェイプを選択しているコードです。Arrayなどがありますが、複数選択を想定したのもになります。
 
 2行目は、「IncrementLeft 24」で右方向に24だけ移動します。左に移動させる場合はマイナスの値をセットします。
 IncrementLeft なのに正の数で右に移動という変わった仕様になっています。
 
 IncrementLeft は水平方向の移動ですが、IncrementTopで垂直方向の移動もできます。
 こちらもイメージとは逆で、マイナスの値で上方向に移動します。
 
 ActiveSheet.Shapes(“Oval 5”).IncrementTop -10   上方向へ10移動
 ActiveSheet.Shapes(“Oval 5”).IncrementLeft -10   左方向へ20移動

 (Selection部分を書き変えています。)
 
 この2つは相対的な移動で、「マクロの記録」では良く出てきます。

絶対的な位置への移動

 図形シェイプの位置を値として設定したい場合は、Top, Left で指定します。
 この場合はプロパティ値の設定なので、= (イコール)が必要になります。

Sub MacroOrg()
    ActiveSheet.Shapes("Oval 5").Top = 24
    ActiveSheet.Shapes("Oval 5").Left = 48
End Sub

 これでB2セルに収まるように表示されます。

図形シェイプとセルの位置を合わせる

 セルの位置を知ることができ、図形シェイプの位置を設定できるようになりましたので自由に図形シェイプを配置できるようになりました。
 ここでは、下の図のように「」というマークをセルの中心に配置できるようにしてみましょう。

 まずは、図にあるような図形シェイプを作ります。
 図形シェイプの「楕円」を使って、中に「済」の文字を配置して、枠線と文字色を赤にしました。
 
 図形シェイプの名前を得たい場合は、以下のプログラムを実行すれば取得できます。

Sub myShapeName()
    Dim sp As Shape
    For Each sp In ActiveSheet.Shapes
        Debug.Print sp.Name
    Next
End Sub

 済マーク (“Oval 1”) を正確に位置に移動させるプログラムは以下の通りです。

Sub setShapePos()
    With Range("B2")
    
    ActiveSheet.Shapes("Oval 1").Top = .Top + .Height / 2 - ActiveSheet.Shapes("Oval 1").Height / 2
    ActiveSheet.Shapes("Oval 1").Left = .Left + .Width / 2 - ActiveSheet.Shapes("Oval 1").Width / 2
    
    End With
End Sub

 セルの位置とサイズ、図形シェイプのサイズで、図形シェイプの Top, Left を割り出しています。
 With Range(“B2”)  の部分を別のセルに指定すれば、簡単に移動出来て便利です。

まとめ

 セルの位置と図形シェイプの位置を取得、設定できれば図形シェイプを自由な位置に配置させるのは、それほど難しくはありません。
 図形シェイプがたくさんある場合は、例に挙げた myShapeName() で名前を見つけることができるでしょう。たくさんの図形シェイプを整列させる時などに便利です。

コメント

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