【VBA】大量写真データの貼付けを完全自動化するマクロの作り方
大量の写真をエクセルに手作業で貼り付けて、サイズを調整して、キレイに並べて…毎回この作業に何時間も費やしていませんか？
VBAを使えば、そのしんどい写真貼付け作業をボタン1クリックで処理できます。
この記事では私が実際に現場で使っていた写真貼付けVBAを紹介します。
このVBAを導入してからは、20枚以上の写真編集に2〜3時間かかっていた作業が30分以内で完了するようになりました。
「写真の大きさを揃えるのが面倒くさい」「貼り付け位置がズレてしまう」「毎回同じ単純作業にうんざりしている」という方は、ぜひこの記事を参考にVBAを使った自動化に挑戦してみてください。
手作業で写真を貼り付けることの3つの問題点
写真をエクセルに貼り付ける作業は、一見すると単純に思われますが、大量の写真を扱うと次のような問題が次々と出てきます。
問題①：サイズ調整に膨大な時間がかかる
写真編集の１番の問題はサイズ調整に時間がかかることです。
写真はカメラや設定によってサイズがバラバラなため、印刷範囲内にキレイに収めようとすると1枚ずつ手動で幅・高さを調整しなければなりません。
私が以前いた職場では、毎月「現場の作業写真を報告書に貼り付けて提出する」という業務がありました。
20枚の写真を貼り付けて大きさを揃えて、印刷レイアウトも整えて…この作業だけで毎月2〜3時間を消費していたほどです。
誰もが「なんでこんな単純作業にこんなに時間がかかるんだ…」と感じていたと思いますが、それでも手作業で続けていました。
問題②：貼り付け位置がズレてミスが起きやすい
２つ目の問題は、貼付け位置を揃えることが難しいことです。
「1枚だけ少し右にはみ出している」「上下の余白が不揃い」といった細かいズレが出て、見栄えのいい資料に仕上げるために何度も微調整が必要です。
また、写真の縦横比を意識しないまま貼り付けると、画像が引き伸ばされて不自然な見た目になってしまうことも頻繁に起きます。
1枚でもズレると全体的に見栄えが悪くなるので、チェック作業にも気を遣わなければならず、精神的にも疲れる作業です。
問題③：毎回同じ手順を繰り返す非効率な作業
３番目の問題は、毎回手間と時間のかかる作業をしなければならないことです。
月次・週次で同じ形式の写真付き資料を作成している場合、毎回まったく同じ手順を繰り返すことになります。
これほど非効率な作業はありません。
1回やるだけでも時間がかかる作業を、毎月・毎週繰り返しているわけですから、累積の損失時間は相当なものです。
VBAを導入すれば、この3つの問題をすべてまとめて解決できます。
しかも一度設定してしまえば、次回からはボタン1クリックで完了させることが可能です。
写真貼付けVBAとは？何ができるのか
写真貼付けVBAとは、エクセルに写真データを自動で挿入・整列・サイズ調整してくれるマクロプログラムです。
具体的にできることを整理すると、以下のようなことが可能になります。
指定したフォルダ内の写真を自動で読み込んで貼り付ける、貼り付けた写真の縦横比を維持したままセルに合わせてサイズを自動調整する、写真をセルの中央に自動で配置する
これらの処理を、すべてVBAが自動でこなしてくれます。
つまり、「写真を貼り付ける」「サイズを調整する」「位置を揃える」という手作業の3ステップを、たった1クリックで処理できるようになるわけです。
プログラミングの知識がなくても使えますし、一度エクセルファイルに設定してしまえばその後の運用は非常に簡単です。
関連記事「写真の貼付けを完全自動化するマクロ」では、写真を貼り付けるVBAが設定されたエクセルファイルをダウンロードすることができます。
実際にVBAを動かしてみて便利さを体感してみてください。
写真貼付けVBAの作り方｜基本コードから理解する
写真貼付けVBAは、AddPictureメソッドを使って画像ファイルをエクセルシートに挿入します。
まずは最もシンプルな「ダブルクリックで1枚ずつ写真を貼り付けるVBA」のコードを見ていきましょう。
①ダブルクリックで写真を貼り付けるVBA（1枚選択貼付け）
このVBAは、セルをダブルクリックするとファイル選択ダイアログが表示され、選択した写真をそのセルに自動で貼り付けてくれます。
結合したセルの行数が18行以上の場合にのみ動作するように条件を設定することで、誤操作を防ぐことができます。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Dim myF As Variant
Cancel = True
'結合セルの行数が18行以上の場合のみ動作する（誤操作防止）
If ActiveCell.MergeArea.Rows.Count > 17 Then
'画像ファイル選択ダイアログを表示する
myF = Application.GetOpenFilename _
("jpg bmp tif png gif,*.jpg;*.bmp;*.tif;*.png;*.gif", , "画像の選択", , False)
If myF <> False Then
With ActiveSheet.Shapes.AddPicture( _
Filename:=myF, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=Target.Left, _
Top:=Target.Top, _
Width:=-1, _
Height:=-1)
'縦横比を維持したままサイズを調整する
.LockAspectRatio = True
.Width = Target.Width
If .Height > Target.Height Then .Height = Target.Height
'写真をセルの中央に配置する
.Top = Target.Top + Target.Height / 2 - .Height / 2
.Left = Target.Left + Target.Width / 2 - .Width / 2
End With
End If
End If
End Subこのコードの処理の流れを解説します。
最初の If ActiveCell.MergeArea.Rows.Count > 17 Then は、ダブルクリックしたセルの結合行数をチェックする条件です。
18行以上結合されたセルでないと動作しないようにすることで、通常のセル編集中に誤ってダイアログが開いてしまうことを防いでいます。
次の Application.GetOpenFilename は、パソコン上のファイル選択ダイアログを表示するコードです。
JPG・BMP・TIF・PNG・GIFの画像形式に対応しているので、ほとんどの写真ファイルを選択可能。
AddPicture で写真を指定したセルに貼り付けた後、.LockAspectRatio = True で縦横比を固定します。
これをしないと、セルのサイズに無理やり引き伸ばされて写真が歪んでしまいます。
最後の .Top と .Left の計算式は、写真をセルの縦横それぞれの中央に配置するためのコードです。
このコードがあることで、写真が常にセルの真ん中に整列されます。
②フォルダ内の写真を一括で貼り付けるVBA（複数写真まとめて処理）
先ほどのVBAは1枚ずつ選択して貼り付けるタイプでしたが、写真の枚数が多い場合は「指定したフォルダ内の写真を全部まとめて貼り付ける」VBAの方が効率的です。
次のコードは、設定シートに記入したフォルダパスを読み込んで、そのフォルダ内にある写真を順番に所定のセルへ自動貼付けするVBAです。
Sub 写真一括貼付け()
Dim folderPath As String
Dim fileName As String
Dim ws As Worksheet
Dim wsSet As Worksheet
Dim targetCell As Range
Dim i As Integer
'設定シートからフォルダパスを取得する
Set wsSet = ThisWorkbook.Worksheets("設定")
folderPath = wsSet.Range("A1").Value
'貼り付け先シートを指定する
Set ws = ThisWorkbook.Worksheets("写真")
'フォルダパスの末尾に¥をつける
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
'画面の更新を停止して処理速度をアップさせる
Application.ScreenUpdating = False
'貼り付け開始セルの行番号
i = 2
'指定フォルダ内のJPGファイルを順番に処理する
fileName = Dir(folderPath & "*.jpg")
Do While fileName <> ""
Set targetCell = ws.Cells(i, 2)
With ws.Shapes.AddPicture( _
Filename:=folderPath & fileName, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=targetCell.Left, _
Top:=targetCell.Top, _
Width:=-1, _
Height:=-1)
'縦横比を維持してサイズを調整する
.LockAspectRatio = True
.Width = targetCell.Width
If .Height > targetCell.Height Then .Height = targetCell.Height
'写真をセルの中央に配置する
.Top = targetCell.Top + targetCell.Height / 2 - .Height / 2
.Left = targetCell.Left + targetCell.Width / 2 - .Width / 2
End With
'次のファイルへ進む
fileName = Dir()
i = i + 5 '5行ごとに次のセルへ移動する
Loop
'画面更新を再開する
Application.ScreenUpdating = True
MsgBox "写真の貼付けが完了しました。", vbInformation
End Sub
コードの流れを順に解説します。
Dir(folderPath & “*.jpg") は、指定フォルダ内にあるJPGファイルを1件ずつ取得するコードです。
Do While fileName <> “" のループで、フォルダ内に写真がある限り処理を繰り返します。
貼り付け位置は変数 i で管理しており、1枚貼り付けるたびに i = i + 5 で5行分移動しています。
これは写真を貼り付けるセルが5行分の高さになっていることを想定した設定です。
ご自身の資料のセル構成に合わせて、この数値を変更してください。
Application.ScreenUpdating = False は処理中の画面描画を止めることで、マクロの実行速度を格段に速くするコードです。
処理が終わったら True に戻すことを忘れないようにしましょう。
このVBAを使うには、「設定」シートのA1セルに写真が入ったフォルダのパスを入力しておく必要があります。
実行結果がこちら
セルの大きさに合わせ等間隔で写真の貼付けができました。
貼付け場所のコードを調整すれば、仕事で使っている様式に合わせることが可能です。
写真貼付けVBAを実際の業務で使う際の設定手順
VBAコードを書いても、正しく設定しないと動作しません。
ここでは、実際に使えるようにするための設定手順を解説します。
VBAエディタへのコードの貼り付け方
まず、エクセルを開いて「Alt + F11」キーを押すとVBAエディタが起動します。
ダブルクリックで写真を貼り付けるタイプのVBAは、対象シートのシートモジュールに貼り付ける必要があります。
VBAエディタ左側のプロジェクトツリーで、対象シート名（例：「写真」シート）をダブルクリックして開き、コードを貼り付けます。
一括貼付けタイプのVBAは、挿入メニューから「標準モジュール」を追加して、そこにコードを貼り付けてください。
VBAをボタンに登録する方法
毎回VBAエディタを開いて実行するのは手間がかかります。
エクセルシート上にボタンを置いて、クリックするだけでVBAが実行できるようにしましょう。
「開発」タブの「挿入」から「フォームコントロール」のボタンを選択して、シート上に配置します。
ボタンを配置すると「マクロの登録」ダイアログが表示されるので、「写真一括貼付け」を選択してOKを押せば設定完了です。
「開発」タブが表示されていない場合は、「ファイル」→「オプション」→「リボンのユーザー設定」から「開発」にチェックを入れてください。
写真貼付けVBAを使う際の注意点
VBAで写真を自動貼付けする際、いくつか注意すべきポイントがあります。
フォルダパスの末尾に¥をつける
フォルダパスを変数に格納するとき、末尾に「\」が付いていない場合があります。
If Right(folderPath, 1) <> “\" Then folderPath = folderPath & “\" というコードで末尾の¥を自動で補完する処理を入れておくと、パスの記入ミスによるエラーを防ぐことができます。
写真の縦横比は必ず固定する
.LockAspectRatio = True を必ず入れましょう。
これを省略すると、縦長の写真がセルの横幅に合わせて引き伸ばされて、不自然な見た目になってしまいます。
「幅をセルに合わせた後、高さがセルからはみ出す場合は高さを優先する」という処理にすることで、縦横どちらの写真でもキレイに収まります。
既存の写真が残っていないか確認する
写真の貼り付け先シートに、以前の写真データが残ったまま一括貼付けを実行すると、重複して貼り付けられてしまいます。
再実行する前に既存の写真オブジェクトを削除する処理を追加しておくと安全です。
'シート上の全ての図形（写真）を削除する
Dim shp As Shape
For Each shp In ws.Shapes
shp.Delete
Next shpこのコードを一括貼付けVBAの最初に入れておくことで、実行のたびに写真がリセットされてクリーンな状態で貼り付けが始まります。
写真貼付けVBAの応用｜さらに便利に使うテクニック
基本のVBAを覚えたら、さらに業務に合わせてカスタマイズしていきましょう。
写真ファイル名をセルに自動表示する
写真を貼り付けた際に、そのファイル名を隣のセルに自動で表示させると、写真と名前の対応確認がしやすくなります。
'写真のファイル名を取得して隣のセルに表示する
Dim ds1 As Integer, ds2 As Integer
Dim fileNameOnly As String
ds1 = InStrRev(myF, "\")
fileNameOnly = Mid(myF, ds1 + 1)
ds2 = InStrRev(fileNameOnly, ".")
ws.Cells(targetCell.Row, targetCell.Column + 1) = Mid(fileNameOnly, 1, ds2 - 1)
InStrRev は文字列を後ろから検索する関数で、ファイルパスから「\」の位置を特定することでファイル名だけを取り出せます。
報告書や点検記録など、写真の管理番号や撮影場所をファイル名で管理している業務では、このテクニックがとても役立ちます。
PNG・BMP・GIFにも対応させる
先ほどのフォルダ一括貼付けVBAは .jpg のみを対象にしていましたが、他の画像形式にも対応させることができます。
'JPG・PNG・BMP・GIFすべてに対応させる
Dim extensions(3) As String
extensions(0) = "*.jpg"
extensions(1) = "*.png"
extensions(2) = "*.bmp"
extensions(3) = "*.gif"
Dim ext As Integer
For ext = 0 To 3
fileName = Dir(folderPath & extensions(ext))
Do While fileName <> ""
'写真貼付け処理（省略）
fileName = Dir()
Loop
Next ext
拡張子の配列を用意してループさせることで、複数の画像形式を一括で処理できます。
スマートフォンで撮影したPNG形式の写真や、古いカメラのBMP形式にも対応できるので、現場によって写真の種類が混在する場合でも安心して使えます。
まとめ ～ 写真貼付け作業にはVBAを使った自動化が必須 ～
この記事で紹介した内容をまとめます。
手作業で写真を貼り付けているとサイズ調整・位置揃え・毎回同じ手順の繰り返しという問題が発生しますが、VBAを導入すればこれらの問題をまとめて解決可能です。
ダブルクリックで1枚ずつ貼り付けるVBAは Worksheet_BeforeDoubleClick イベントを使って実装でき、フォルダ内の写真を一括貼付けするVBAは Dir 関数と AddPicture メソッドの組み合わせで実装できます。
写真の縦横比は .LockAspectRatio = True で固定することが大前提。
既存写真の削除、ファイル名の自動取得といった応用テクニックを加えることで、さらに使い勝手のいいVBAに仕上げることができます。
「最初はコードが難しそう…」と感じるかもしれませんが、この記事で紹介したコードはコピーしてそのまま使えるレベルに仕上げていきましょう。
まずは試してみることが大事です。
1回動かしてみれば、VBAがどれだけ強力かを実感できるはずです。
もし「自分の業務に合わせた複雑な写真貼付け処理を実装したい」「既存のマクロを改良したい」といったご要望がありましたら、マメBlogのエクセルマクロ開発依頼にご相談ください。
業務内容に合わせたオーダーメイドマクロを設定させていただきます。
最後まで読んでいただきありがとうございました。
エクセルVBAを使って面倒なルーティーン作業を自動化しちゃいましょう。