Excel に画像ファイルを自動貼り付け
Excel のワークシートに画像ファイルを貼り付けるには「挿入」タブの「図」→「画像」で画像ファイルを選択しますが、大量の画像ファイルをワークシート上に配置したいとき、毎回画像ファイルを選択して貼り付けるのは時間がかかります。
以前、この作業を自動化するために Excel VBA でプログラムを作成していたことがあって、それを再利用して動かしてみたのですが、今の Excel では不具合が起きました。それについて紹介しておきます。
以下のようにファイル名が連番になっている png ファイルを読み込み、ワークシート上に格子状に貼り付けるという作業で、全部で450ファイルあります。これを1枚ずつ手作業でやっていたら1日かかってしまうのでプログラムで自動化しました。
0101-1.png, 0101-2.png, 0101-3.png
0102-1.png, 0102-2.png, 0102-3.png
0103-1.png, 0103-2.png, 0103-3.png
0104-1.png, 0104-2.png, 0104-3.png
0105-1.png, 0105-2.png, 0105-3.png
0201-1.png, 0201-2.png, 0201-3.png
…
3001-1.png, 3001-2.png, 3001-3.png以前作成していた VBA のコードは以下のようなもので、ワークシート Sheet1～Sheet30 に 5×3 の格子状に画像を貼り付けています。画像を読み込んでから指定の位置（B6,L6,V6,B29,～）に移動してもいいのですが、このコードはアクティブセルを移動してから画像を貼り付けるようにしています。
Dim ImageFolderName As String, ImageFileName As String
Dim LineNo(5) As Integer, ColNo(3) As Integer
ImageFolderName = ThisWorkbook.Path & "\Image\"
LineNo(1) = 6
LineNo(2) = 29
LineNo(3) = 52
LineNo(4) = 75
LineNo(5) = 98
ColNo(1) = 2
ColNo(2) = 12
ColNo(3) = 22
For k = 1 To 30
Worksheets("Sheet" & Format(k)).Select
For i = 1 To 5
For j = 1 To 3
ImageFileName = ImageFolderName & Format(k, "00") & Format(i, "00") & "-" & Format(j) & ".png"
With ActiveSheet
.Cells(LineNo(i), ColNo(j)).Select
.Pictures.Insert ImageFileName
End With
Next j
Next i
Cells(1, 1).Select
Next k
コードを実行させてみると、確かに画像ファイルが読み込まれてワークシート上に表示されます。これで問題ないと思って Excel ファイルを保存したところ、ファイルサイズが明らかに小さいことが気になりました。今の Excel ファイルはこんなに圧縮して保存されるのかと思いましたが、確認したところやはり画像がリンクとして貼り付けられていました。
このため、元の画像ファイルを削除したりフォルダ名を変えたりすると「リンク切れ」と表示されて画像は消えてしまいます。また、Excel ファイルのみを相手に渡すと、相手の環境では画像が表示されないことになります。
調べたところ、「Pictures.Insert」というコードは今はリンク貼り付けという機能になっていました。Excel 2010 から仕様が変わったみたいですが、マイクロソフトも面倒なことをやってくれたものです。
そこで、リンクではなく画像として貼り付ける方法を調べてみると、今は「Shapes.AddPicture」を使うということでした。ただし、そのままだとなぜか画像サイズが自動で調整されてしまうので、100% にリセットするという操作が必要になります。
Dim ImageFolderName As String, ImageFileName As String
Dim LineNo(5) As Integer, ColNo(3) As Integer
Dim AddShape As Shape
ImageFolderName = ThisWorkbook.Path & "\Image\"
LineNo(1) = 6
LineNo(2) = 29
LineNo(3) = 52
LineNo(4) = 75
LineNo(5) = 98
ColNo(1) = 2
ColNo(2) = 12
ColNo(3) = 22
For k = 1 To 30
Worksheets("Sheet" & Format(k)).Select
For i = 1 To 5
For j = 1 To 3
ImageFileName = ImageFolderName & Format(k, "00") & Format(i, "00") & "-" & Format(j) & ".png"
With ActiveSheet
.Cells(LineNo(i), ColNo(j)).Select
Set AddShape = .Shapes.AddPicture( _
Filename:=ImageFileName, _
linktofile:=False, _
savewithdocument:=True, _
Left:=Selection.Left, _
Top:=Selection.Top, _
Width:=0, _
Height:=0)
End With
With AddShape
.LockAspectRatio = False
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft
.LockAspectRatio = True
.ZOrder msoSendToBack
With .Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Weight = 1
End With
End With
Next j
Next i
Cells(1, 1).Select
Next k
このコードを実行させてファイル保存すると、ファイルサイズもそれなりの大きさになっていて、他のPCでも問題なく画像が表示されます。
なぜこんな改変をやったのか不思議ですが、ともかくもこれで大量の画像を貼り付けるという面倒な単純作業が自動化できます。Excel の単純作業は VBA を使ってできるだけ自動化していきましょう。
