PowerPoint (一般・VBA)

PowerPoint 一般・VBAに関する話題を扱うフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : PowerPoint 2016)
PowerpointVBAで指定Shapeオブジェクトを削除したい。
投稿日時: 20/01/15 15:36:56
投稿者: gorby

Powerpointファイルを開いて、ホーム-配置-オブジェクトの選択と表示 でスライドのShapeオブジェクト一覧が表示されます。
このPowerpointファイルから、
 
すべての画像
すべての線
すべての"hogehoge"を含むTextbox
Shapeオブジェクト名称に"テキスト ボックス 2"を含むTextbox
 
を削除しようとして、下記のPowerpointVBAを実行したところ、
 
       Select Case s.Name
 
のところで、Shapeオブジェクトが存在しません というエラーで止まりました。
不思議なことに、"テキスト ボックス 2" だけでなく"テキスト ボックス"を含むすべての
テキストボックスShapeオブジェクトが削除されていました。英語のtextboxオブジェクトは削除されず残っていました。
コードをどう直せば、"テキスト ボックス 2"を指定して削除できますか? わかる方教えてください。
 
---<Start of code>---
 
Sub delete()
 
 Dim s As Shape 'sはshapeオブジェクトを入れる変数
 Dim c As Collection 'cはコレクション
 Dim start_slide As Integer 'start_slideはスライド番号1を入れる定数
 Dim i As Integer 'iはスライド番号を入れる変数
 
 start_slide = 1
 For i = start_slide To ActivePresentation.Slides.Count
 'If i = 254 Then
 ' GoTo continue
 'End If
  Set c = New Collection
  For Each s In ActivePresentation.Slides(i).Shapes '変数sにアクティブスライド番号のすべてのshapeオブジェクトを入れる。
   c.Add s
  Next
  For Each s In c
    Select Case s.Type
                 Case msoPicture
                    s.delete
                 Case msoLine
                    s.delete
                 Case msoTextBox
                    If InStr(s.TextFrame.TextRange.Text, "hogehoge") > 0 Then s.delete '★ここが重要!
                 Case Else
                     '何もしない
    End Select
  Next
   For Each s In c
       Select Case s.Name
                 Case InStr(s.Name, "テキスト ボックス 2") > 0
                    s.delete
                 Case Else
                     '何もしない
       End Select
   Next
 Next
 
End Sub
---<End of code>---
 
 

回答
投稿日時: 20/01/15 17:45:24
投稿者: なと

まず、解説はしますが、自身の手でF8によるデバッグ・トレースを推奨します。
それで意図しない動きをしている箇所を正しく理解できると思います。
 

引用:
"テキスト ボックス"を含むすべてのテキストボックスShapeオブジェクトが削除されていました

は再現できませんでした。
たまたま、全てのテキストボックスの内容が「hogehoge」だったのであれば、「すべての"hogehoge"を含むTextbox」に該当するため全て消えてしまいますが、そんなことはないですよね?
 
引用:
Shapeオブジェクトが存在しません というエラーで止まりました。

については、ロジックのミスです。
 
このプログラムを翻訳すると
1.cコレクションにShapesコレクション全てのShapeへの参照を格納
2.cのうち、条件1,2,3に一致する図形をShapesから削除
3.cのうち、条件4に一致する図形をShapesから削除
です。
 
エラーの原因は「s.delete」はShapesコレクションから削除(実物を削除)しているのであって、cコレクションからは削除していないということです。
この時点の「c」の中身をローカルウィンドウでチェックされると宜しいかと思います。
 
2で既に削除した図形を3のForEach文で参照した時は「s」の中身は「Nothing」になっています。
Nothingのsにはプロパティはありませんから「s.Name」でエラーが発生します。
 
解決策としては幾つか考えられますが、好きな手法を試してみて下さい。
・3の前に1と同じ処理をもう一度行う。
・ForEachを2回に分けない。
 例えばSelect Case文での判定は諦めて全ての判定をIf〜ElseIf〜EndIfに書き換える
・削除フラグを建てて、判定と削除のループを分離する。
 
cにせよShapesにせよ、ForEach対象のコレクションをループ内で削除すると副作用が起こる可能性があるので避けたほうが無難です。上手くいくかもしれませんが、しっかりテストして下さい。

投稿日時: 20/01/16 13:43:59
投稿者: gorby

 
 
 
アドバイスありがとうございます。
さて、
・3の前に1と同じ処理をもう一度行う。[/quote]
ことにして、下記のコードを実行してみました。正常終了しましたが、"テキスト ボックス 2"という名前のShapeオブジェクトは削除されませんでした。どうしてでしょうか?
 
 
--<Start of code>----
 
Sub deleteTextBox2()
 
 Dim s As Shape 'sはshapeオブジェクトを入れる変数
 Dim c As Collection 'cはコレクション
 Dim start_slide As Integer 'start_slideはスライド番号1を入れる定数
 Dim i As Integer 'iはスライド番号を入れる変数
 
 start_slide = 1
 For i = start_slide To ActivePresentation.Slides.Count
 'If i = 254 Then
 ' GoTo continue
 'End If
  Set c = New Collection
   
  For Each s In ActivePresentation.Slides(i).Shapes '変数sにアクティブスライド番号のすべてのshapesオブジェクトを入れる。
   c.Add s
  Next
    
   For Each s In c
       Select Case s.Name
                 Case InStr(s.Name, "テキスト ボックス 2") > 0
                    s.delete
                 Case Else
                     '何もしない
       End Select
   Next
 Next
 
End Sub
--<End of code>----
 
 
 

回答
投稿日時: 20/01/17 12:02:09
投稿者: なと

見落としてました。

       Select Case s.Name
                 Case InStr(s.Name, "テキスト ボックス 2") > 0
                    s.delete
                 Case Else
                     '何もしない
       End Select

 
は、意図したとおりにSelect文が書けていません。
 
「Select Case s.Name」は、s.Nameの値が後のCaseの値と一致するか?で分岐します。
 
たとえば、s.Nameの値が「"テキスト ボックス 2"」だったとしましょう。
しかし、次のように評価されます。
Case InStr(s.Name, "テキスト ボックス 2") > 0
Case 1 > 0
Case True
 
つまり s.Nameの"テキスト ボックス 2" と Trueは当然異なりますから、スルーされます。

回答
投稿日時: 20/01/17 12:05:12
投稿者: なと

追記。代替案は2つ考えられます。
 
一つはIf文にすること。
 
もう一つは、いわゆるSelect文の裏技記法と言われる書き方「Select Case True」に変更すること。
https://www.moug.net/tech/exvba/0150120.html
 
意味をよく理解して、好きな方法をお使い下さい。

トピックに返信