色の知識で人生の可能性が広がる!みんなに役立つ色彩検定 >>

以前こちらで教えていただいたプログラムで一括で図形を挿入して
その後、指定したオブジェクトのみを削除で下記のコードでできるようになりました。
しかし、別のPC(Windows1064bit)で実施したらほかのオブジェクトも一括で削除されしました。
別のファイルでも同様にすべて消えてしまいました。
テキストファイル内(100ページくらい)で画像を選択して同じものを一括で削除したのですがいい方法ありませんか?
・クリックした画像と同じもの
・代替テキストにある名前と同じ画像ファイル方法
・画像に名前を登録した登録して実施する方法
・情報で大きさを取得して同じサイズのもの
よろしくお願いします。

Private Sub CommandButton17_Click()
Dim i As Integer, n As Integer
Dim Act_Pg_No As Integer, End_Pg_No As Integer
Dim iNo As Integer
Dim shpN As Variant

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

On Error GoTo Not_SelectionErr

shpN = Split(Selection.ShapeRange.Name, " ")

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

教えて!goo グレード

A 回答 (2件)

こんにちは


coffee breakで回答するのは少し難しいですね
>大きさも同じで判断できますが、モノによっては同じ大きさもあります。
大きさはダメと言う事ですね

>過去のデータなのでファイル名とかもわかりません。
過去に作られたDocumentだとすると名前は変更されている可能性もありますね。インデックスも順番に挿入されたとは限らないので 名前+添え字も
ダメと言う事になりそうですね。

>画像ファイルです。
この画像はリボンの挿入ー>画像ー>ファイル名を指定して挿入されたもの?
その場合、ActiveDocument.Shapesでは取得できず
ActiveDocument.InlineShapes となり、さらに.Nameプロパティがありません
なので、インデックスで選択できるものの名前を取得してシェイプ名で選択する事は出来ないと思いました。

なので、問題がないようでしたら
図形を Shape オブジェクトに変換し、他のShape同様に扱えるようにした方が良いようです。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

>クリックしてサイズを取得して同じサイズを別フォームで入力して
できればと考えていました。

ユーザーフォームを使用するのなら、処理用Wordを作成しそのファイルにVBAを組みます。
処理対象Wordを開いて 開いたDocumentに対して先ず情報をリストボックスなどに取得します
InlineShapeが >0ならば Shapeに変換
ユーザーフォームはUserForm1.Show (vbModeless)でロードしてあれば
削除したいShapeを選択、選択したShape情報をテキストボックスなどに取得して確認し、必要条件(同じ画像の条件)を選択(複数選択できるような構造、テキストボックスにリンクするチェックボックスなど)

選択条件でシェイプを削除・・・

んん、、過去のデータ、100ページくらいで画像がどのくらいあるか分からないですが、同じであると特定するのは難しいかも知れませんね。

挿入して直ぐ(挿入する作業が特定できる)状態なら色々方法がありそうですがね。

参考までに取得するコード 他の取得プロパティはオブジェクトブラウザーで確認できます

Sub Document_Shapes()
Dim shp As Shape
Debug.Print "Shapes.Count=="; ActiveDocument.Shapes.Count
Debug.Print "InlineShapes.Count=="; ActiveDocument.InlineShapes.Count

For Each shp In ActiveDocument.Shapes
Debug.Print "ShapeName := "; shp.Name; " ::-> Type := "; shp.Type
Next

Dim inlineShape As Object
For Each inlineShape In ActiveDocument.InlineShapes
If inlineShape.Type = wdInlineShapePicture Then
Debug.Print "inlineShape.Height :="; inlineShape.Height; "inlineShape.Width :="; inlineShape.Width
End If
Next
End Sub

InlineShapes.Count==が 1<=なら変換した方が良いかな。

InlineShapesはインデックスで指定することも出来ます
InlineShapes(n)
inlineShapeのプロパティは  画像で(小さくて見えないかも・・)

coffee breakではなくなってしまいましたので取り合えず
「VBA 過去のファイル内の同じオブジェク」の回答画像2
    • good
    • 0
この回答へのお礼

ありがとうございます。
サンプルファイルですが下記のような表記になるのでしょうか?
Shapes.Count=>1 115
InlineShapes.Count==; ActiveDocument.InlineShapes.Count
ShapeName := Graphic 1 ::-> Type := 28
ShapeName := テキスト ボックス 3 ::-> Type := 17


ShapeName := テキスト ボックス 1 ::-> Type := 17
ShapeName := Picture 5 ::-> Type := 13
ShapeName := テキスト ボックス 3 ::-> Type := 17
ShapeName := Picture 14 ::-> Type := 13



ShapeName := Picture 21 ::-> Type := 13
ShapeName := テキスト ボックス 1 ::-> Type := 17
ShapeName := テキスト ボックス 1 ::-> Type := 17
ShapeName := Picture 115 ::-> Type := 13
ShapeName := Picture 116 ::-> Type := 13
ShapeName := Picture 117 ::-> Type := 13

色々試してみようと思います。
下記のようなイメージで
pg = Selection.Information(wdNumberOfPagesInDocument)
For i = 1 To pg
Selection.GoTo What:=wdGoToPage, _
Which:=wdGoToAbsolute, _
Count:=i
’フォームから取得
.Height = TextBox1.Value '高さ
.Width = TextBox2.Value '幅
End With
.Item(i).Delete
Next
End sub

お礼日時:2022/01/27 23:54

こんばんは


本日は遅く明日もあるのでよくいていませんが
https://oshiete.goo.ne.jp/qa/12722824.html
で回答したコードと思います。

ご質問が良く分からない所があります。
>その後、指定したオブジェクトのみを削除
全ページに挿入された指定したオブジェクトを削除です。

>別のPC(Windows1064bit)で実施したらほかのオブジェクトも一括で削除されしました。

PC依存のメソッドなどは使用されていないと思います。
>別のファイルでも同様にすべて消えてしまいました。
先にも上げましたが、VBAで全ページに挿入されたオブジェクトに対して削除するもので他の方法で挿入されたモノやシェイプ名を変更した場合は該当しません。ただし、削除される事はありません。

また、1ページで見つかった場合、削除した後 Exit For でシェイプを探すループを抜け
Selection.GoTo What:=wdGoToPage, _
Which:=wdGoToAbsolute, _
Count:=i 
で次のページに移ると思います。
(同じページにある複数のオブジェクトは削除する事はありません。

デバッグしていれば、その結果を示してください。
結果だけを示されても問題が分かりません。


ところで、

>テキストファイル内(100ページくらい)で画像を選択して同じものを>一括で削除したのですがいい方法ありませんか?
Wordの事で良いですか

・クリックした画像と同じもの
同じとは何を指しますか? タイプ、名前+添え字、形、大きさ。色、配置

・代替テキストにある名前と同じ画像ファイル方法
基準は?重複を無くすと言う事?

・画像に名前を登録した登録して実施する方法
名前?テキストの事?

・情報で大きさを取得して同じサイズのもの
情報とは?比較基準は?何から取得するの
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
再びありがとうございます。

>全ページに挿入された指定したオブジェクトを削除です。
前頁でした。

>先にも上げましたが、VBAで全ページに挿入されたオブジェクトに対して削除するもので他の方法で挿入されたモノやシェイプ名を変更した場合は該当しません。ただし、削除される事はありません。
確認中です。

>Wordの事で良いですか
Wordです。前頁のうちで同じ画像を使用していたりする場合です。

・クリックした画像と同じもの
>同じとは何を指しますか? タイプ、名前+添え字、形、大きさ。色、配置
画像ファイルです。過去のデータなのでファイル名とかもわかりません。
大きさも同じで判断できますが、モノによっては同じ大きさもあります。


・代替テキストある名前と同じ画像ファイル方法
>基準は?重複を無くすと言う事?
フォームで基準となるテ代替キストの言葉をいれて、画像ファイルの代替テキストに指定の文字が記載されている場合にすべて削除とかにできないか

・画像に名前を登録して実施する方法
>名前?テキストの事?
判定できないのでなしで

・情報で大きさを取得して同じサイズのもの
>情報とは?比較基準は?何から取得するの
Private Sub CommandButton10_Click()
With ActiveDocument.Shapes(1)
MsgBox "左端から" & .Left & "ポイント" & vbCrLf & _
"上端から" & .Top & "ポイント" & vbCrLf & _
"幅は" & .Width & "ポイント" & vbCrLf & _
"高さは" & .Height & "ポイント"
End With
End Sub
クリックしてサイズを取得して同じサイズを別フォームで入力して
できればと考えていました。

お礼日時:2022/01/25 05:11

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング