t-hom’s diary

主にVBAネタを扱っているブログです。

VBA PowerPointでShapeを一気に削除するマクロ

こちらのブログで、PowerPoint VBAでFor Eachを使ってShapeを消すとうまくいかないという問題が紹介されていた。

chemiphys.hateblo.jp

やってみたところ、実際に1つ飛ばしで削除される。

実際に検証

Excelで検証してみた。

Sub Excel版ShapeAdd()
    Dim i As Long
    For i = 10 To 200 Step 10
        Sheets(1).Shapes.AddShape _
            msoShapeRectangle, i, i, 100, 50
    Next
End Sub

Sub Excel版ShapeDelete()
    Dim s As Shape
    For Each s In Sheets(1).Shapes
        s.Delete
    Next
End Sub

Excelの場合、For Eachで回してもうまく消えてくれる。

パワポ版で同等のマクロを書いてみたところ、

Sub PPT版ShapeAdd()
    Dim i As Long
    For i = 10 To 200 Step 10
        ActivePresentation.Slides(1).Shapes.AddShape _
            msoShapeRectangle, i, i, 100, 50
    Next
End Sub
Sub PPT版ShapeDel()
    Dim s As Shape
    For Each s In ActivePresentation.Slides(1).Shapes
        s.Delete
    Next
End Sub

一つ飛ばしで削除される。
f:id:t-hom:20170101090907p:plain

原因

これはやはりchemiphysさんの予想通り、Shapes内部のイテレーターがおかしいのだと思う。

この事象はプログラミングの世界ではよくある。
たとえばA~Eの文字が1~5番のインデックスで管理されているとする。
1:A
2:B
3:C
4:D
5:E

1を消すと、こうなるのではなく。
2:B
3:C
4:D
5:E

このようにズレ込む。
1:B
2:C
3:D
4:E

さて、1を消したから次は2だ。
1:B
2:D
3:E

次は3だ。
1:B
2:D

ということで一つ飛ばし。

ExcelのShapesでこの事象が起こらないのにPowerPointだけそうなるのは、同じShapesでも別物だから。
よく似ていて、だいたい同じように扱えるけど微妙に違う。
thom.hateblo.jp

解決法

ひとつはchemiphysさんのブログに書かれているようにFor EachをあきらめてForを使うこと。
For文でIndexを後ろから当たれば消してもズレ込むことはない。

もう一つは一旦Collectionに入れてから削除する方法が考えられる。

一旦Collectionに入れて消すコードは以下のとおり。

Sub PPT版ShapeDel2()
    Dim s As Shape
    Dim c As Collection: Set c = New Collection
    For Each s In ActivePresentation.Slides(1).Shapes
        c.Add s
    Next
    For Each s In c
        s.Delete
    Next
End Sub

ただ2回ループで回す羽目になる。
メインコードでこれをするのは嫌なので、クラスモジュールを使って少し抽象化。

まずクラスモジュールを挿入し、オブジェクト名を「ShapeDeleter」とする。
以下のコードを貼り付け。

Private c As Collection

Private Sub Class_Initialize()
    Set c = New Collection
End Sub

Sub Throw(s As Shape)
    c.Add s
End Sub

Sub Delete()
    For Each x In c
        x.Delete
    Next
End Sub

標準モジュールのコードはこう変わる。

Sub PPT版ShapeDel3()
    Dim SD As ShapeDeleter: Set SD = New ShapeDeleter
    Dim x As Shape
    For Each x In ActivePresentation.Slides(1).Shapes
        SD.Throw x
    Next
    SD.Delete
End Sub

考え方は以下の記事で紹介したRangeゴミ箱と同じ。
thom.hateblo.jp

捨てるものを一旦溜めておいて、一気にDeleteできるようになる。
まぁクラス内部ではループさせてるので結局やっていることは同じだけれど、少し抽象化が進んだ。
クラスを利用した抽象化は色々と応用が利くので便利。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。