質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.53%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

Q&A

解決済

2回答

1341閲覧

VBAでWordの画像の差し替え

hana_87

総合スコア1

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Word

Microsoft WordはMicrosoftが開発した業務用の文書生成用のソフトウェアです。

0グッド

0クリップ

投稿2023/06/23 02:11

編集2023/06/28 10:17

実現したいこと

VBAでWordの画像の差し替えをしたい

前提

wordVBAで画像の差し替えを行うプログラムを作っています。
画像は行内ではありません。

発生している問題・エラーメッセージ

画像を差し替えることができず困っています。
おそらく18行目部分が誤っているものだと思われます。
Selection.ShapeRange.Fill.UserPicture picpath

該当のソースコード

VBA

1Sub picreplace() 2 Dim doc As Document 3 Dim shape As shape 4 5 Set doc = ActiveDocument 6 7 Dim picpath As String 8 picpath = "ファイルパス" 9 10 Dim j As Byte 11 12 For j = 1 To ActiveDocument.Shapes.Count 13 14 Set shape = doc.Shapes(j) 15 16 If shape.Type = msoPicture Then 17 shape.Select 18 Selection.ShapeRange.Fill.UserPicture picpath 19 20 End If 21 22 Set shape = Nothing 23 Next j 24 25 Set doc = Nothing 26 27 28End Sub 29

試したこと

差し替え前の画像を選択することはできているようです。

追記

vba

1 If shape.Type = msoPicture Then 2 shape.Select 3 shleft = shape.Left 4 shtop = shape.Top 5 shape.Delete 6 doc.Shapes.AddPicture FileName:=picpath, Left:=shleft, Top:=shtop 7 8 End If 9

上記のように、削除したあと同じ位置に追加する処理に変更したのですが、変更される画像と変更されない画像があります。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

bebebe_

2023/06/23 06:20

変更されるものとされないものがあるのであればされないもののTypeが「msoPicture」ではないということはないですか?
hana_87

2023/06/26 01:38

ご指摘ありがとうございます。 if文の中でmsoPictureの数を出力する処理を仮で挿入してみたところ、変更したい画像の個数と同じ数が出力されたので、変更したい画像はすべてmsoPictureだと思われます。
bebebe_

2023/06/26 03:48

状況が再現できないので原因がわかりませんがIF内を「shape.Select Replace:=False」だけにした場合変更されない画像も選択されますか?
hana_87

2023/06/26 04:53

コメントありがとうございます。 IF内を「shape.Select Replace:=False」だけにした場合、変更されない画像を含む変更したい画像のすべてが選択されます。
guest

回答2

0

ベストアンサー

1つの文書内にあるすべての画像を全く同一の画像に差し替えようとしています。

以上のコメントを受けて、次のように変更しました(2023/06/27 10:53)。

vba

1Sub ResetAllPicturesInActiveDocument() 2 3 Dim strPicturePath As String 4 Dim lngResetCount As Long 5 6 strPicturePath = "C:\FolderName\FileName.png" 7 8 Dim wrdShape As Word.Shape 9 10 For Each wrdShape In ActiveDocument.Shapes 11 Select Case wrdShape.Type 12 Case msoPicture, msoLinkedPicture 13 If ResetPicture(wrdShape, strPicturePath) Is Nothing Then 14 Exit Sub 15 End If 16 lngResetCount = lngResetCount + 1 17 Case Else 18 '何もしない 19 End Select 20 Next 21 22 If lngResetCount > 0 Then 23 MsgBox "この文書の描画レイヤーの図を " & lngResetCount & " 個差し替えました。", _ 24 vbInformation, _ 25 "実行完了 (ResetAllPicturesInActiveDocument)" 26 Else 27 MsgBox "この文書の描画レイヤーに挿入されている図はありません。", _ 28 vbInformation, _ 29 "実行完了 (ResetAllPicturesInActiveDocument)" 30 End If 31 32End Sub 33 34Function ResetPicture(TargetShape As Word.Shape, NewPicturePath As String) As Word.Shape 35On Error GoTo Err_ResetPicture 36 37 If Dir(NewPicturePath) = "" Then 38 MsgBox "指定されたパス""" & NewPicturePath & """に該当するファイルが見つかりません。", _ 39 vbExclamation, _ 40 "ファイル参照エラー (ResetPicture)" 41 Exit Function 42 End If 43 44 Dim strShapeName As String 45 Dim varLeftRelative As Variant 46 Dim varRelativeHorizontalPosition As Variant 47 Dim varLeft As Variant 48 Dim varTopRelative As Variant 49 Dim varRelativeVerticalPosition As Variant 50 Dim varTop As Variant 51 52 With TargetShape 53 Select Case .Type 54 Case msoPicture, msoLinkedPicture 55 '何もしない 56 Case Else 57 MsgBox "図形""" & .Name & """は図ではありません。", _ 58 vbExclamation, _ 59 "オブジェクト参照エラー (ResetPicture)" 60 Exit Function 61 End Select 62 63 .Select 64 strShapeName = .Name 65 varLeftRelative = .LeftRelative 66 varRelativeHorizontalPosition = .RelativeHorizontalPosition 67 If .LeftRelative = wdShapePositionRelativeNone Then 68 varLeft = .Left 69 End If 70 varTopRelative = .TopRelative 71 varRelativeVerticalPosition = .RelativeVerticalPosition 72 If .TopRelative = wdShapePositionRelativeNone Then 73 varTop = .Top 74 End If 75 End With 76 77 Application.ScreenUpdating = False 78 79 Dim wrdNewShape As Word.Shape 80 81 Set wrdNewShape = ActiveDocument.Shapes.AddPicture(FileName:=NewPicturePath, _ 82 LinkToFile:=False) 83 84 With TargetShape 85 .LeftRelative = wdShapePositionRelativeNone 86 .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage 87 .TopRelative = wdShapePositionRelativeNone 88 .RelativeVerticalPosition = wdRelativeVerticalPositionPage 89 End With 90 91 With wrdNewShape 92 93 .WrapFormat.Type = TargetShape.WrapFormat.Type 94 95 .LeftRelative = wdShapePositionRelativeNone 96 .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage 97 .Left = TargetShape.Left 98 99 .TopRelative = wdShapePositionRelativeNone 100 .RelativeVerticalPosition = wdRelativeVerticalPositionPage 101 .Top = TargetShape.Top 102 103 .LeftRelative = varLeftRelative 104 .RelativeHorizontalPosition = varRelativeHorizontalPosition 105 If .LeftRelative = wdShapePositionRelativeNone Then 106 .Left = varLeft 107 End If 108 109 .TopRelative = varTopRelative 110 .RelativeVerticalPosition = varRelativeVerticalPosition 111 If .TopRelative = wdShapePositionRelativeNone Then 112 .Top = varTop 113 End If 114 115 Do While .ZOrderPosition > TargetShape.ZOrderPosition 116 .ZOrder msoSendBackward 117 Loop 118 119 End With 120 121Exit_ResetPicture: 122On Error Resume Next 123 124 If Not wrdNewShape Is Nothing Then 125 TargetShape.Delete 126 wrdNewShape.Name = strShapeName 127 Set ResetPicture = wrdNewShape 128 End If 129 130 Application.ScreenUpdating = True 131 132 Exit Function 133 134Err_ResetPicture: 135 136 MsgBox Err.Number & ": " & Err.Description, _ 137 vbCritical, _ 138 "実行時エラー (ResetPicture)" 139 140 If Not wrdNewShape Is Nothing Then 141 wrdNewShape.Delete 142 Set wrdNewShape = Nothing 143 End If 144 145 Resume Exit_ResetPicture 146End Function

投稿2023/06/23 06:38

編集2023/06/27 01:53
sk.exe

総合スコア693

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hana_87

2023/06/26 04:52 編集

ご回答ありがとうございます。 こちらのコードを実行したところ、画像が1つ差し替わりました。 勉強不足で申し訳ございません。 複数個の画像を変更したいため、 Set wrdShape = Selection.ShapeRange.Item(1) を(2)に変更したところ、「プロシージャの呼び出しまたは引数が不正です」と出てしまいました。
sk.exe

2023/06/26 05:24 編集

> 複数個の画像を変更したい 1つの文書内にある複数個の(全ての、または何らかの条件に該当する、あるいは複数選択された)図を、全く同一の画像に差し替えようとされているのでしょうか(何のために?)。
hana_87

2023/06/27 00:49

書き方が悪く申し訳ございません。 1つの文書内にあるすべての画像を全く同一の画像に差し替えようとしています。 理由といたしましては、文中にあるQRコードの変更です。
hana_87

2023/06/28 01:17

ありがとうございます。 解決いたしました。
guest

0

この回答はGPT-4による自動生成回答です

以下のコードで画像の差し替えができるはずです。Selection.ShapeRange.Fill.UserPicture picpath の代わりに、shape.Fill.UserPicture picpath を使用しています。

VBA

1Sub picreplace() 2 Dim doc As Document 3 Dim shape As Shape 4 5 Set doc = ActiveDocument 6 7 Dim picpath As String 8 picpath = "ファイルパス" 9 10 Dim j As Byte 11 12 For j = 1 To ActiveDocument.Shapes.Count 13 14 Set shape = doc.Shapes(j) 15 16 If shape.Type = msoPicture Then 17 shape.Fill.UserPicture picpath 18 End If 19 20 Set shape = Nothing 21 Next j 22 23 Set doc = Nothing 24End Sub

このコードを使用して、Word文書内の画像を指定したファイルパスの画像に差し替えることができます。ただし、picpath には差し替えたい画像の正しいファイルパスを指定してください。

投稿2023/06/23 02:12

teratail-ai

Powered by GPT-4

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hana_87

2023/06/23 02:26

こちらのコードに変更しても、画像は差し替わりませんでした。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.53%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問