Shapeの書式をコピーする(PickUp/Applyメソッド)|Excel VBA |
すでに書式を設定してあるShapeから他のShapeに書式をコピーするには、PickUpメソッドとApplyメソッドを組み合わせて使います。
サンプル1ではShapeを2つ作成し、1つ目のShapeに書式設定を行った後、同じ書式を2つ目のShapeに適用します。
Sub Sample1()
'四角形のShapeを作成
With ActiveSheet.Shapes.AddShape _
(msoShapeRectangle, 100, 100, 100, 30)
.Fill.ForeColor.RGB = vbRed '書式を設定
.PickUp '書式をコピー
End With
'丸型のShapeを作成
With ActiveSheet.Shapes.AddShape _
(msoShapeOval, 100, 200, 50, 50)
.Apply 'コピーした書式を適用
End With
End Sub
Shapeを2つ作成した後に一括して書式を設定するには、サンプル2のように対象のShapeを含むShapeRangeコレクションを取得して書式設定します。
Sub Sample2()
Dim MyShape1 As Shape, MyShape2 As Shape
With ActiveSheet.Shapes
'四角形のShapeを追加
Set MyShape1 = .AddShape _
(msoShapeRectangle, 100, 100, 100, 30)
'丸型のShapeを追加
Set MyShape2 = .AddShape _
(msoShapeOval, 100, 200, 50, 50)
'一括して書式を設定
.Range(Array(MyShape1.Name, MyShape2.Name)) _
.Fill.ForeColor.RGB = vbRed
End With
End Sub