お客様から、画像をファイルに自動的にWordファイルに挿入するマクロの開発のご依頼をいただきました。
数十のファイルを挿入すると、かなり手間です。
お客様からのご要望は、ファイルを並べ替えたり、ファイルの種類を特定したり、画像ファイル名の特定の部分だけを画像と共に挿入したりと、様々な要望がありました。また、そもそも画像ファイルにリンクさせるのかどうか、リンク画像を保存するのかどうかなどファイルの作成ルールにより処理も異なると思います。
そうです。実務では現場ごとに様々な処理が要求されます。
この記事では、画像ファイルのファイルパスと画像を挿入することだけを実行します。
＜目次＞
このマクロでできること
現在開かれているWordファイルが保存されているフォルダ内にある画像のうち、jpg形式とgif形式のファイルを文書の末尾に挿入します。
ファイルへのリンクはしません。
以下のようにsample1.docxファイルが保存されているフォルダ内に3つの画像ファイルが保存されています。test1.jpg, test2.gif, test3.pngと保存形式が異なります。
sample1.docxを開いてこのマクロを実行します。
（マクロ実行前）
（マクロ実行後）
test3.pngは挿入されません。
マクロの解説
文書の末尾の特定方法
文書の末尾に挿入しています。場所の特定は、32行目で
myDoc.Bookmarks("\EndOfDoc").Range
としています。組み込みのブックマークで指定できます。
これ以外の記述では、少し冗長になりますが
myDoc.Range((myDoc.Range.End - 1, myDoc.Range.End - 1)
としても同じ箇所を指定できます。上記で -1 として、文書の末尾の段落記号の1つ手前を指定します。
画像の挿入方法
AddPicture メソッドを使います。
文書の末尾で、まず画像の挿入（33行目）の後にファイルパスの挿入（34行目）をしています。
でも、入力位置に注目してください。
ファイルパスが書かれて、その下に画像が入ります。
これは、画像挿入の挙動に癖があるからです。
文書末尾に画像を挿入したのですが、挿入した位置は画像の直前箇所のままなのです。
なので、同じ挿入位置にファイルパスの文字列を挿入すると、画像の直前になるのです。
画像のリンク方法
画像にリンクさせるならば、AddPicture メソッドの引数（LinkToFile:=True）でリンクを指定してください。
画像の種類の特定方法
28行目から32行目で画像の種類を特定しています。ここに拡張子を追加すれば画像の種類別の処理ができます。
マクロ
Sub 画像の挿入()
Dim myFolderPath As String 'フォルダパス
Dim myFileName As String 'ファイル名
Dim myFilePath As String 'ファイルパス
Dim myExtension As String '拡張子
Dim myDoc As Document
Dim FSO As Object
'-------------------------------------------
'前処理
'-------------------------------------------
Set myDoc = ActiveDocument
Set FSO = CreateObject("Scripting.FileSystemObject")
myFolderPath = myDoc.Path
'-------------------------------------------
'画像データの挿入
'-------------------------------------------
'フォルダ中の任意のファイルを検索
myFileName = Dir(myFolderPath & "\", vbNormal)
Do While myFileName <> ""
myExtension = LCase(FSO.GetExtensionName(myFileName))
Select Case myExtension
Case "jpg", "gif"
myFilePath = myFolderPath & "\" & myFileName
With myDoc.Bookmarks("\EndOfDoc").Range
.InlineShapes.AddPicture FileName:=myFilePath
.InsertAfter Text:=vbCr & myFilePath & vbCr
End With
Case Else
End Select
myFileName = Dir()
Loop
'-------------------------------------------
'オブジェクト変数の解放
'-------------------------------------------
Set FSO = Nothing
Set myDoc = Nothing
End Sub