PowerPoint (一般・VBA)

PowerPoint 一般・VBAに関する話題を扱うフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : PowerPoint 2016)
PowerpointVBAで複数のShapeオブジェクトを選択削除したい。
投稿日時: 19/12/25 17:32:11
投稿者: gorby

Powerpointファイルを開いて、
ホーム-配置-オブジェクトの選択と表示 でスライドのShapeオブジェクト一覧が右側に表示されます。
そのうち、”Rectangle 2”という名前のShapeオブジェクトと画像すべてを削除するため、下記のコードを実行して、動くことを確認しました。
ところが、コードを動かせた後に、なぜか、"タイトル”という名前のShapeオブジェクト(タイトルを入力 と表示されるテキストボックスです)が新規に発生するため、これも削除するため
 
 
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Then s.delete
という部分を
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Or (InStr(s.Name, "タイトル") > 0) Then s.delete
とor文を3個連続してつなげて実行しましたが、構文エラーになります。
 
解決策がわかる方、ご教示をお願いします。
 
 
--<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
   
  Set c = New Collection
  For Each s In ActivePresentation.Slides(i).Shapes '変数sにアクティブスライド番号のすべてのshapeオブジェクトを入れる。
    c.Add s
  Next
  For Each s In c
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Then s.delete
  Next
 Next
   
 End Sub
  --<end of code>-----

回答
投稿日時: 19/12/26 10:26:57
投稿者: sk

引用:
”Rectangle 2”という名前のShapeオブジェクトと画像すべてを削除するため、
下記のコードを実行して、動くことを確認しました。
ところが、コードを動かせた後に、なぜか、"タイトル”という名前の
Shapeオブジェクト(タイトルを入力 と表示されるテキストボックスです)
新規に発生する

・あるスライド内のタイトルプレースホルダーの名前に
 (何故か)"Rectangle 2"という文字列が含まれており、
 かつ既にタイトルが設定されている
 
・そのプレースホルダーを削除すると同時に
 空のタイトルプレースホルダーが新たに挿入される。
 ( PowerPoint の仕様通りの動作)
 
ということなのでは。

投稿日時: 19/12/26 10:56:59
投稿者: gorby

sk さんの引用:
引用:
”Rectangle 2”という名前のShapeオブジェクトと画像すべてを削除するため、
下記のコードを実行して、動くことを確認しました。
ところが、コードを動かせた後に、なぜか、"タイトル”という名前の
Shapeオブジェクト(タイトルを入力 と表示されるテキストボックスです)
新規に発生する

・あるスライド内のタイトルプレースホルダーの名前に
 (何故か)"Rectangle 2"という文字列が含まれており、
 かつ既にタイトルが設定されている
 
・そのプレースホルダーを削除すると同時に
 空のタイトルプレースホルダーが新たに挿入される。
 ( PowerPoint の仕様通りの動作)
 
ということなのでは。

 
それでは、 挿入された空のタイトルプレースホルダーを削除するためには、どうコードを修正すれば良いでしょうか?

回答
投稿日時: 19/12/26 11:49:48
投稿者: sk

引用:
挿入された空のタイトルプレースホルダーを削除するためには、
どうコードを修正すれば良いでしょうか?

そもそもの話として、「プレースホルダーだろうが何だろうが
『"Rectangle 2" という文字列が名前に含まれている図形』を
問答無用で消し去ること」を処理の目的とされているのでしょうか。
 
またそうすることによって、そのプレゼンテーションファイルが
最終的にどのような状態になることを目指されているのでしょうか。
 
それぞれの図形の Name プロパティの初期値は、その図形の種類に応じて
PowerPoint によって自動的につけられているものですが、
仮に "Rectangle 2" という名前が初期値のままなのであれば、
その図形は恐らくタイトルプレースホルダーではなく
「オートシェイプの正方形/長方形」であるはずです。
 
つまり、gorby さんが本当になさりたいのは
「全てのスライドから『オートシェイプの正方形/長方形』を削除すること」
であって、プレースホルダーまで削除する必要はないのではないかと、
私は疑っています。
(「タイトルのテキストを空にしたい」ならまだ分かるが、
「スライドからタイトルそのものをなくす」というのは
PowerPoint の使い方としてあまりふさわしくない)
 
いずれにしても、図形の名前の初期値はあくまで初期値でしかありません。
[オブジェクトの選択と表示]ウィンドウ上で任意のオブジェクトを選択し、
別の名前に変更することも出来ます。
 
今回の場合、"Title 1" のような名前がつけられているはずの
タイトルプレースホルダーがどういうわけだか "Rectangle 2"
という名前に変更されているようですが、図形の種類や属性ではなく
図形の名前を「削除すべきオブジェクト」の条件としてしまえば
当然こういう結果となり得ますし、またスライド上の長方形が
"Rectangle 2" ではない名前に変更されていたら、逆に削除対象から
外れることになります。
 
以上のことを踏まえた上で、ご自分がなさろうとしていることを
再度整理されることをお奨めします。

回答
投稿日時: 19/12/27 14:01:49
投稿者: んなっと

最初にスライドのレイアウトを空白に変更するのはどうですか?
 
Sub test()
  Dim Pre As Presentation
  Dim Sld As Slide
  Dim Shp As Shape
  Dim i As Long
  Set Pre = ActivePresentation
  Pre.Slides.Range.Layout = ppLayoutBlank
  For Each Sld In Pre.Slides
    For i = Sld.Shapes.Count To 1 Step -1
      Set Shp = Sld.Shapes.Item(i)
      Select Case Shp.Type
        Case msoPlaceholder
          If Shp.PlaceholderFormat.Type = ppPlaceholderTitle Then
            Shp.Delete
          End If
        Case msoPicture
          Shp.Delete
      End Select
      Set Shp = Nothing
    Next i
  Next
End Sub
 
 
このスレッドについて意見を書かせてください。↓
https://www.moug.net/faq/viewtopic.php?t=78798
事務局も面倒ごとはお気に召さないようですね。
私個人としては、削除された回答者の指摘は正当なものだったと思います。

投稿日時: 20/01/10 16:48:00
投稿者: gorby

gorby さんの引用:
Powerpointファイルを開いて、
ホーム-配置-オブジェクトの選択と表示 でスライドのShapeオブジェクト一覧が右側に表示されます。
そのうち、”Rectangle 2”という名前のShapeオブジェクトと画像すべてを削除するため、下記のコードを実行して、動くことを確認しました。
ところが、コードを動かせた後に、なぜか、"タイトル”という名前のShapeオブジェクト(タイトルを入力 と表示されるテキストボックスです)が新規に発生するため、これも削除するため
 
 
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Then s.delete
という部分を
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Or (InStr(s.Name, "タイトル") > 0) Then s.delete
とor文を3個連続してつなげて実行しましたが、構文エラーになります。
 
解決策がわかる方、ご教示をお願いします。
 
 
--<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
   
  Set c = New Collection
  For Each s In ActivePresentation.Slides(i).Shapes '変数sにアクティブスライド番号のすべてのshapeオブジェクトを入れる。
    c.Add s
  Next
  For Each s In c
    If (InStr(s.Name, "Rectangle 2") > 0) Or (s.Type = msoPicture) Then s.delete
  Next
 Next
   
 End Sub
  --<end of code>-----