VBA～同心図形を描こう～Excel

VBAで同心図形を描きたい場合は、塗りつぶしなしのオートシェイプを作成し、それを複製し複製したオートシェイプを元のオートシェイプと重ねてから中心を保持したまま拡大、縮小すれば描けます。

下のコードを実行すると円の同心図形を描きます。

Sub test1()

Dim Dshape As Shape

ActiveSheet.Shapes.AddShape(msoShapeOval, 50, 50, 72, 72).Fill.Visible = msoFalse
Set Dshape = ActiveSheet.Shapes(1).Duplicate

Dshape.Left = ActiveSheet.Shapes(1).Left
Dshape.Top = ActiveSheet.Shapes(1).Top
Dshape.ScaleWidth 2, msoFalse, msoScaleFromMiddle
Dshape.ScaleHeight 2, msoFalse, msoScaleFromMiddle

End Sub

コードの説明

Dim Dshape As Shape

Dshapeという変数はShapeオブジェクトであると宣言しています。

ActiveSheet.Shapes.AddShape(msoShapeOval, 50, 50, 72, 72).Fill.Visible = msoFalse

Shapes.AddShapeメソッドはAddShape(オートシェイプの種類, 左位置, 上位置, 幅, 高さ)になるので位置やサイズを変更したい場合は左位置、上位置、幅、高さで設定できます。msoShapeOvalが楕円で円にしたい場合は幅、高さを同じにします。塗りつぶしなしにしたい場合はFillFormat.VisibleプロパティをmsoFalseに設定します。

Set Dshape = ActiveSheet.Shapes(1).Duplicate

Dshapeという変数に複製したオートシェイプを代入しています。この時点でオートシェイプが複製されます。

Dshape.Left = ActiveSheet.Shapes(1).Left

Leftプロパティで複製したオートシェイプの左位置を元のオートシェイプの左位置に設定しています。

Dshape.Top = ActiveSheet.Shapes(1).Top

Topプロパティで複製したオートシェイプの上位置を元のオートシェイプの上位置に設定しています。これでオートシェイプが重なります。

Dshape.ScaleWidth 2, msoFalse, msoScaleFromMiddle

複製したオートシェイプの幅を2倍にしています。Shape.ScaleWidthメソッドはScaleWidth(比率,RelativeToOriginalSize,保持する部分)で設定できます。RelativeToOriginalSizeは拡大縮小する場合はmsoFalseを指定します。保持する部分は中心を保持したい場合はmsoScaleFromMiddleを指定します。

Dshape.ScaleHeight 2, msoFalse, msoScaleFromMiddle

複製したオートシェイプの高さを2倍にしています。