wordでの指定オブジェクトの削除

wordで数十ページある文書でマクロを組んでおり、
何ページ及び前頁にオブジェクト（図）を挿入できるようにしております。
この図を削除をしたいのですが
まとめて削除はできたのですが、他の図を削除せずにマクロで組んだ図を削除したいです。

Private Sub CommandButton1_Click()
With ActiveDocument.Shapes
Dim i As Long
For i = .Count To 1 Step -1
.Item(i).Delete
Next
End With
End Sub

消したい画像はダイアログから引っ張ってきた
' 図の挿入ダイアログで図を指定
Set oDialog = Dialogs(wdDialogInsertPicture)
With oDialog
.Display
で選べるようにしているものです。

クリックとかで選ぶか、引っ張ってきた情報を引き継いで消せるのか
よろしくお願いいたします

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2021/12/22 17:39

こんばんは＃３です

＞全ページ削除やvbMoodelessでフォームを起動しておいて選択したオブジェクトを削除とかはできないでしょうか？

各ページにこちらhttps://oshiete.goo.ne.jp/qa/12714690.htmlで回答したコードなどを使い追加されたシェイプが対象になります。
（各ページに同時期に（VBAで）（1ファイルを基に）追加されたシェイプ）

vbModelessでUserFormをShow(load)して
削除したいShapeを選択してCommandButton?を押下した時の処理です
全頁、同時に追加された該当シェイプが削除されます。

Private Sub CommandButton?_Click()　'？登録ボタン№
Dim i As Integer, n As Integer
Dim Act_Pg_No As Integer, End_Pg_No As Integer
Dim iNo As Integer
Dim shp As Shape, shpN As Variant

With Selection
Act_Pg_No = .Information(wdActiveEndPageNumber)
End_Pg_No = .Information(wdNumberOfPagesInDocument)
End With

On Error GoTo Not_SelectionErr
For Each shp In Selection.ShapeRange
shpN = Split(shp.Name, " ")
Next
iNo = CInt(shpN(1)) - (Act_Pg_No - 1)
' 各ページごとの処理
For i = 1 To End_Pg_No
Selection.GoTo What:=wdGoToPage, _
Which:=wdGoToAbsolute, _
Count:=i
' 画像処理
With ActiveDocument.Shapes
For n = .Count To 1 Step -1
If .Item(n).Name = shpN(0) & " " & CStr(iNo) Then
.Item(n).Delete
Exit For
End If
Next
End With
iNo = iNo + 1
Next
Exit Sub
Not_SelectionErr:
MsgBox "Shapeが選択されていません。"

End Sub

選択したシェイプのみ削除する場合は

Private Sub CommandButton？_Click()
Selection.Range.ShapeRange.Item(1).Delete
End Sub

*現在Wordの画像操作においてアップデートによる不具合が発生しているようです。
VBA実行に対しても問題が発生する可能性もあると思いますので
未確認ですが、ご留意を

この回答へのお礼

回答ありがとうございます。
上手くいきました。指定のとおりに動作できました。
ありがとうございます。
今回の作成しているマクロではNo.5、6の Qchan1962さんの方式のほうで行きたいと思いますのでベストアンサーに選ばさせていただきました。

お礼日時：2021/12/23 05:07

No.6 回答者： Qchan1962 回答日時： 2021/12/22 17:57

＃５　修正です、すみません。

For Each shp In Selection.ShapeRange
shpN = Split(shp.Name, " ")
Next

For Each shp In Selection.ShapeRange　’不要
shpN = Split(Selection.ShapeRange.Name, " ")　’修正
Next ’不要
よってshp As Shape, ’不要 ですﾈ

No.4 回答者： enunokokoro 回答日時： 2021/12/22 09:56

参考までに。

No.1の回答者さんが書いたように、名前があれば処理が簡単です。
ダイアログで挿入する際に、独自の名前を付ければ処理は単純に
なりますので、
https://docs.microsoft.com/ja-jp/office/vba/api/ …

こちら↓の処理を使うなら「画像処理」の下部分に追加します。
Set PIC = ActiveDocument.Shapes.AddPicture(FileName:=.Name)
With PIC
.Name = "独自の名前" & i 　' この部分を追加（連番はページ番号）

削除するマクロは、No.1のお礼にあるように
Dim i As Long
With ActiveDocument.Shapes
For i = .Count To 1 Step -1
If .Item(i).Name Like "独自の名前*" Then
.Item(i).Delete
End If
Next
End With
で処理できます。

この回答へのお礼

回答ありがとうございます。
動作確認できました。
独自の名前を取り込む際につけることで削除できました。
大変勉強にになりました。ありがとうございます。

お礼日時：2021/12/23 05:04

No.3 回答者： Qchan1962 回答日時： 2021/12/21 12:03

こんにちは

＞全ページにつけており、その後間違って消したい場合に上記コードを例えば40回繰り返せばいいのですがそれだと効率が悪いためいい方法を考えておりました。

前頁と言う事で最後に追加したShapeで良いでしょうか
方法は色々あるようですが、
参考：https://www.relief.jp/docs/word-vba-select-page. …
Sub Last_Shape_del() ' 最後の挿入画像を削除
Dim pg As Page
With ActiveWindow
.View.Type = wdPrintView
For Each pg In .ActivePane.Pages
pg.Rectangles(1).Range.Select
With ActiveDocument.Shapes
If .Count > 0 Then .Item(.Count).Delete
End With
Next pg
End With
End Sub

＊If .Count > 0　はShapeの存在しないシートがある時の対策です

この回答へのお礼

回答ありがとうございます。勉強になります。
ページ削除確認できました。
しかし、なぜか毎回その後ファイルが閉じて自動修復で再起動になってしまいます。

保存してしまった場合を考慮してあとから
指定したファイル名のオブジェクトを全ページ削除やvbMoodelessでフォームを起動しておいて選択したオブジェクトを削除とかはできないでしょうか？

お礼日時：2021/12/22 01:38

No.2 回答者： Qchan1962 回答日時： 2021/12/20 16:45

こんにちは

＞クリックとかで選ぶか、引っ張ってきた情報を引き継いで消せるのか
両方共に出来ると思いますし方法は色々あります。
＞クリックとかで選ぶ
ユーザーフォームからでvbModelessでロードしていれば
オブジェクトを選択する事が可能ですね

また、（多分このように使いたいのかな）
VBAで挿入した画像をキャンセルの意味などで直後に削除したい場合は
一番大きいインデックスアイテム（最後に作られたShape）を
削除すれば良いので

With ActiveDocument.Shapes
.Item(.Count).Delete
End With

更に
＃１様が回答されているようにNameプロパティで分岐、削除する方法や
各プロパティ　Typeや色などを手掛かりに削除する方法が考えられます。

ShapeにTextFrame.TextRangeがあれば、テキスト内容で削除したり
逆に無い時のエラーをキーにテキストのないTypeを削除する事も出来ます。

例えばこのような場合は
既存（残したいShape）が固定で5つある場合などは
ご質問のコードのループ終端を6にすれば、初めからある
5つのShapeは削除されないような処理も出来ます。
With ActiveDocument.Shapes
Dim i As Long
For i = .Count To 6 Step -1
.Item(i).Delete
Next
End With

この回答へのお礼

回答ありがとうございます。参考になります。
ひとつ前のオブジェクトをキャンセルすることはできました。ありがとうございます。
文書は40ページぐらいあり図とかもいろいろあってそこにタイトル的に一括でオブジェクトを下記の方法で全ページにつけており、その後間違って消したい場合に上記コードを例えば40回繰り返せばいいのですがそれだと効率が悪いためいい方法を考えておりました。
pg = Selection.Information(wdNumberOfPagesInDocument)
For i = 1 To pg
Selection.GoTo What:=wdGoToPage, _
Which:=wdGoToAbsolute, _
Count:=i

もう一つの方法でページ数分の数を選択してみましたが数ページの削除でうまくいきませんでした。
Private Sub CommandButton13_Click()
Dim i As Long
With ActiveDocument.Shapes
For i = .Count To 39 Step -1
.Item(i).Delete
Next
End With
End Sub

前提事項が一部抜けていたためわかりにくくてすいませんでした。

お礼日時：2021/12/21 02:04

No.1 回答者： mygoonickname 回答日時： 2021/12/20 11:01

おはようございます。

下記の様な記載で、名前とかで区別できないでしょうか？
区別できれば、IF文などで分岐すれば、可能では？と思います。

For i = .Count To 1 Step -1
IF .Item(i).Name LIKE "*消したい図の名前など*"　THEN
.Item(i).Delete
END IF
Next

この回答へのお礼

回答ありがとうございます。
勉強不足ですいません。こういうことでしょうか？
Private Sub CommandButton14_Click()
Dim i As Long
With ActiveDocument.Shapes
For i = .Count To 1 Step -1
If .Item(i).Name Like "sumple.jpg" Then
.Item(i).Delete
End If
Next
End With
End Sub

お礼日時：2021/12/21 01:57