HOME > 即効テクニック > Excel VBA > > Shapeの書式をコピーする(PickUp/Applyメソッド)

Shapeの書式をコピーする(PickUp/Applyメソッド)|Excel VBA

図形操作関連のテクニック

Shapeの書式をコピーする(PickUp/Applyメソッド)

(Excel 2000/2002/2003/2007/2010)

すでに書式を設定してあるShapeから他のShapeに書式をコピーするには、PickUpメソッドとApplyメソッドを組み合わせて使います。
サンプル1ではShapeを2つ作成し、1つ目のShapeに書式設定を行った後、同じ書式を2つ目のShapeに適用します。

●サンプル1●

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コレクションを取得して書式設定します。

●サンプル2●

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