2022-01-31

ＶＢＡ・図形の書き方

1.図形にテキストを入力する方法

図形にテキストを入力するには「Charactersオブジェクト」の「Textプロパティ」でテキストを入力したり、入力されている文字列を取得することができます。

「Charactersオブジェクト」は「Shaepオブジェクト」の「TextFrameプロパティ」で、「TextFrameオブジェクト」を取得した、「Charactersメソッド」で取得できます。

次のように記述すると覚えてください。

また、テキストのFontの設定は「セルのフォントサイズ、種類、表示位置を指定する」をご覧ください。

ActiveSheet.Shapes(1).TextFrame.Characters.Text = "入力したい文字列"

2.図形にテキストを入力するサンプルコード

図形作成と同時にテキストを入力する

まずは図形を作成時と同時にテキストを入力する方法です。

図形は「Shapes.AddShape(タイプ, Left, Top, Width, Height)」で作成します。

Sub Sample1()

'Type,Left,Top,Width,Heightを指定
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 50, 50)

    With .TextFrame.Characters 'テキスト
        .Text = "四角形" '文字列
        .Font.Size = 10 '文字のサイズ
        .Font.Bold = True
    End With
    
End With

End Sub

作成済みの図形を取得してテキストを入力する

次は作成済みの図形を取得してテキストを入力する方法です。

次のように3つの図形がすでにあるワークシートの図形を操作します。

個別に指定して取得する

Sub Sample2()

With ActiveSheet
    
    With .Shapes(1).TextFrame.Characters 'テキスト
        .Text = "四角形1" '文字列
        .Font.Size = 10 '文字のサイズ
        .Font.Bold = True
    End With
    
    With .Shapes(2).TextFrame.Characters 'テキスト
        .Text = "四角形2" '文字列
        .Font.Size = 10 '文字のサイズ
        .Font.Bold = True
    End With
    
    With .Shapes(3).TextFrame.Characters 'テキスト
        .Text = "四角形3" '文字列
        .Font.Size = 10 '文字のサイズ
        .Font.Bold = True
    End With
    
End With

End Sub

ループですべて取得する

Sub Sample3()

Dim i       As Long

With ActiveSheet

    For i = 1 To .Shapes.Count
    
        With .Shapes(i).TextFrame.Characters 'テキスト
            .Text = "四角形" & i '文字列
            .Font.Size = 10 '文字のサイズ
            .Font.Bold = True
        End With
        
    Next i

End With

End Sub

オートシェイプ（図形）を追加する

オートシェイプの種類、位置、サイズを指定して追加

下記の例では、矩形を座標 (100, 50) に、サイズ 200x50 で追加しています。座標やサイズの単位は「ポイント」で指定します。

ActiveSheet.Shapes.AddShape msoShapeRectangle, 100, 50, 200, 50

オートシェイプの種類は下記に一覧があります。

MsoAutoShapeType 列挙

セルと同じサイズで矩形を追加する

' A1 セルに収まるサイズで矩形のオートシェイプを追加
' （見た目としては、セルの背景を塗りつぶしたような感じになる）
With ActiveSheet.Range("A1")
    ActiveSheet.Shapes.AddShape msoShapeRectangle, .Left, .Top, .Width, .Height
End With

' A1:B2 の範囲のセルに収まるサイズでひし形のオートシェイプを追加
With ActiveSheet.Range("A1:B2")
    ActiveSheet.Shapes.AddShape msoShapeDiamond, .Left, .Top, .Width, .Height
End With

セルと同じ高さで横幅だけ指定して矩形を追加する

' B2 のセルに横幅 100 ポイントの矩形を左寄せで追加
With ActiveSheet.Range("B2")
    ActiveSheet.Shapes.AddShape msoShapeRectangle, .Left, .Top, 100, .Height
End With

作成したオートシェイプ（Shape オブジェクト）の参照を取得する

AddShape 関数を Function として呼び出せば、作成された Shape オブジェクトの参照を戻り値として受け取ることができます。 Shape オブジェクトの参照を使って、オートシェイプの書式設定などを行うことができます。

Private Sub SetShapeStyle(ByRef sp As Shape)
    '枠線の設定
    sp.Line.Visible = msoFalse

    '塗りつぶしの設定
    With sp.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 225, 139)
        .Transparency = 0
        .Solid
    End With
End Sub

Sub Main()
    Dim sp As Shape
    With ActiveSheet.Range("A1")
        Set sp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
            .Left, .Top, .Width, .Height)
    End With
    SetShapeStyle sp
End Sub

枠線を設定する

枠あり／なしを切り替える

Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoTrue

枠線の色、透過度を指定する

Selection.ShapeRange.Line.ForeColor.RGB = RGB(255, 0, 0)
Selection.ShapeRange.Line.Transparency = 0

図形の位置を変更する

絶対位置で指定（左上を 0, 0 として 100, 30 へ移動）

Selection.ShapeRange.Left = 100
Selection.ShapeRange.Top = 30

移動量で指定（左へ50ポイント、下へ30ポイントだけ移動）

Selection.ShapeRange.IncrementLeft -50
Selection.ShapeRange.IncrementTop 30

図形のサイズを変更する

ポイントでサイズ指定

Selection.ShapeRange.Width = 200
Selection.ShapeRange.Height = 50

現在サイズからの倍率で指定（横方向、縦方向にそれぞれ1.5倍）

Selection.ShapeRange.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft