こんにちは、SkillStack Lab運営者のスタックです。
工事写真台帳や報告書を作るたびに、Excelへ写真を1枚ずつ貼り付け、セルの大きさに合わせて調整していませんか。
写真の縦横比が崩れたり、結合セルの中央からずれたり、画像が増えてブックが重くなったりすると、単純な貼り付け作業にも意外と時間がかかります。
結論から言うと、VBAで画像の縦横比を固定し、セルの幅と高さを比較してから中央位置を計算すれば、選択したセルや結合セルへ写真を自動サイズ調整して配置できます。
写真が複数ある場合は、フォルダ内のファイル名を取得して並べ替え、決めた間隔で写真枠へ順番に配置することも可能です。
この記事では、1枚の写真を安全に貼り付けるコードから、フォルダ内の複数画像を一括処理するコード、Excelが重くなる場合やマクロが動かない場合の対処法まで順番に解説します。
この記事のVBAは、マクロを実行できるデスクトップ版Excelを前提にしています。Excel for the webではVBAマクロを作成・編集・実行できません。コードを試す前に元ファイルをコピーし、マクロ有効ブック（.xlsm）として作業してください。
- 写真1枚なら、最初に紹介する
PasteAndFitPictureを使う - 結合セルは
ActiveCell.MergeAreaで結合範囲全体を取得する LockAspectRatioで写真の縦横比を維持する- 複数画像はフォルダ取得・並べ替え・繰り返し処理を追加する
- 表示サイズを縮めるだけでは容量対策にならないため、画像圧縮も検討する
- 大量写真や複数人での共有・承認まで必要なら専用ツールも比較する
- 写真をセルや結合セルへ自動サイズ調整して配置するVBAコード
- 画像の縦横比を維持し、中央へ配置する仕組み
- フォルダ内の複数画像をファイル名順に貼り付ける方法
- 一括処理を途中で失敗した場合の確認方法
- 写真でExcelが重くなる場合の対策
- マクロが動かない場合の確認項目
エクセルに写真を貼り付けて自動サイズ調整するVBAコード
まずは、選択中のセルまたは結合セルへ写真を1枚挿入し、縦横比を維持したまま中央へ配置するコードです。
画像は元ファイルへのリンクではなく、Excelブック内へ保存する構成にしています。
そのため、貼り付け後に元画像を別のフォルダへ移動しても、Excel内の写真がリンク切れしにくくなります。
Option Explicit
Private Const PHOTO_MARGIN As Double = 4
Public Sub PasteAndFitPicture()
Dim selectedFile As Variant
Dim targetRange As Range
Dim insertedPicture As Shape
If TypeName(Selection) <> "Range" Then
MsgBox "写真を貼り付けるセルを選択してください。", vbExclamation
Exit Sub
End If
selectedFile = Application.GetOpenFilename( _
FileFilter:="画像ファイル (*.jpg;*.jpeg;*.png;*.bmp),*.jpg;*.jpeg;*.png;*.bmp", _
Title:="貼り付ける写真を選択")
If VarType(selectedFile) = vbBoolean Then Exit Sub
On Error GoTo ErrorHandler
Set targetRange = ActiveCell.MergeArea
Set insertedPicture = AddPictureToRange( _
filePath:=CStr(selectedFile), _
targetRange:=targetRange, _
marginPt:=PHOTO_MARGIN)
MsgBox "写真を貼り付けました。", vbInformation
Exit Sub
ErrorHandler:
MsgBox "写真を貼り付けできませんでした。" & vbCrLf & _
Err.Description, vbExclamation
End Sub
Private Function AddPictureToRange( _
ByVal filePath As String, _
ByVal targetRange As Range, _
ByVal marginPt As Double) As Shape
Dim pictureShape As Shape
Dim maxWidth As Double
Dim maxHeight As Double
Dim errorNumber As Long
Dim errorDescription As String
On Error GoTo ErrorHandler
maxWidth = targetRange.Width - marginPt * 2
maxHeight = targetRange.Height - marginPt * 2
If maxWidth <= 0 Or maxHeight <= 0 Then
Err.Raise vbObjectError + 1000, _
"AddPictureToRange", _
"貼り付け先のセルが小さすぎます。"
End If
Set pictureShape = targetRange.Worksheet.Shapes.AddPicture( _
Filename:=filePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=targetRange.Left, _
Top:=targetRange.Top, _
Width:=-1, _
Height:=-1)
With pictureShape
.LockAspectRatio = msoTrue
If .Width / maxWidth > .Height / maxHeight Then
.Width = maxWidth
Else
.Height = maxHeight
End If
.Left = _
targetRange.Left + _
(targetRange.Width - .Width) / 2
.Top = _
targetRange.Top + _
(targetRange.Height - .Height) / 2
.Placement = xlMoveAndSize
End With
Set AddPictureToRange = pictureShape
Exit Function
ErrorHandler:
errorNumber = Err.Number
errorDescription = Err.Description
On Error Resume Next
If Not (pictureShape Is Nothing) Then
pictureShape.Delete
End If
On Error GoTo 0
Err.Raise errorNumber, _
"AddPictureToRange", _
errorDescription
End FunctionPHOTO_MARGINは、写真とセル枠の間に設ける余白です。
現在は4ポイントにしています。余白を広くしたい場合は「6」や「8」へ変更し、枠いっぱいに近づけたい場合は小さくしてください。
このサンプルのファイル選択画面ではJPEG、PNG、BMPを対象にしています。それ以外の形式を追加する場合は、使用するExcel環境で正常に挿入できることを確認してからフィルターへ追加してください。
このコードは写真を「セル値」にしているわけではない
ここで一つ知っておきたいのが、VBAで挿入した写真の扱いです。
Shapes.AddPictureで挿入した画像は、文字や数値のようにセルへ保存される値ではなく、ワークシート上に配置されるShapeオブジェクトです。
この記事では、Shapeの位置とサイズをセルに合わせ、さらにxlMoveAndSizeを設定することで、セルへ写真を貼り付けたように見える状態を作っています。
そのため、セルを削除したり、行や列のサイズを大きく変更したりした場合は、写真の配置も確認してください。
VBAコードを貼り付けて実行する手順
- 元ファイルをコピーする
本番ファイルを直接編集せず、テスト用のコピーを作成します。 - マクロ有効ブックで保存する
「名前を付けて保存」からExcelマクロ有効ブック（.xlsm）を選択します。 - VBEを開く
Windows版ExcelではAlt＋F11でVisual Basic Editorを開けます。 - 標準モジュールを追加する
VBEの「挿入」から「標準モジュール」を選びます。 - コードを貼り付ける
先ほどのコードを標準モジュールへ貼り付けます。 - 写真枠を選択する
Excelへ戻り、写真を配置したいセルまたは結合セル内の1セルをクリックします。 - マクロを実行する
PasteAndFitPictureを実行して写真を選択します。 - 位置とサイズを確認する
縦長・横長の写真をそれぞれ試し、写真が枠からはみ出さないか確認します。
インターネットから取得したファイルや、処理内容を確認できないマクロは安易に有効化しないでください。
会社のパソコンでマクロ利用が制限されている場合も、設定を独断で弱めるのではなく、情報システム担当者へ確認しましょう。
Microsoftサポートでマクロのセキュリティ設定を確認する
写真の縦横比を維持してセルへ収める仕組み
コードをそのまま使うだけでなく、自分の帳票へ応用できるように、重要な処理を確認しておきましょう。
Shapes.AddPictureで写真をブックへ埋め込む
写真を挿入しているのが、次の部分です。
Set pictureShape = targetRange.Worksheet.Shapes.AddPicture( _
Filename:=filePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=targetRange.Left, _
Top:=targetRange.Top, _
Width:=-1, _
Height:=-1)LinkToFile:=msoFalseによって元画像ファイルへのリンクではなく独立した画像として扱い、SaveWithDocument:=msoTrueでブックと一緒に保存します。
Width:=-1とHeight:=-1は、画像を挿入するときに元画像の幅と高さを保持する指定です。
Microsoft Learn「Shapes.AddPictureメソッド」
LockAspectRatioで写真の縦横比を固定する
セルの幅と高さをそのまま画像へ設定すると、元画像とセルの縦横比が異なる場合に写真が変形します。
そこで、次の設定を使います。
.LockAspectRatio = msoTrue縦横比を固定したうえで、写真と貼り付け先の比率を比較します。
If .Width / maxWidth > .Height / maxHeight Then
.Width = maxWidth
Else
.Height = maxHeight
End If横方向の縮小率の方が大きければ幅を上限にし、縦方向の方が大きければ高さを上限にします。
これにより、写真全体を切り取らずに枠内へ収められます。
セルと写真の縦横比が異なる場合は、写真全体を表示するため上下または左右に余白が残ります。
MergeAreaで結合セル全体を取得する
工事写真台帳では、複数のセルを結合して大きな写真枠を作っていることがあります。
その場合に使うのが次のコードです。
Set targetRange = ActiveCell.MergeArea選択したセルが結合範囲の中にある場合は結合セル全体を取得し、結合されていなければActiveCellそのものが返ります。
MergeAreaは単一セル範囲に対して使用するプロパティです。そのため、このコードでは複数セルを選択したSelectionではなく、単一セルであるActiveCellからMergeAreaを取得しています。
Microsoft Learn「Range.MergeAreaプロパティ」
写真をセルの中央へ配置する
サイズを変更した写真を単純にセルの左上へ置くと、余白が右側や下側へ偏ります。
そのため、左右と上下の余白を2で割り、写真の開始位置へ加算します。
左位置 ＝ セルの左位置 ＋（セル幅 − 写真幅）÷ 2
上位置 ＝ セルの上位置 ＋（セル高さ − 写真高さ）÷ 2
これで縦長・横長の写真でも、写真枠の中央へ配置しやすくなります。
フォルダ内の複数画像をファイル名順に一括貼り付けする
写真が10枚、20枚と増える場合は、毎回ファイル選択画面を開くより、フォルダ内の画像をまとめて処理した方が効率的です。
次のコードでは、最初に選択したセルを1枚目の写真枠として、12行間隔で下へ移動しながらファイル名順に写真を配置します。
このコードは、先ほど紹介したPHOTO_MARGINとAddPictureToRange関数を使用します。1枚用コードと一括処理コードを同じ標準モジュールへ配置してください。
Public Sub PasteFolderPictures()
Const ROW_STEP As Long = 12
Dim folderPath As String
Dim fileNames() As String
Dim fileCount As Long
Dim i As Long
Dim processedCount As Long
Dim startCell As Range
Dim targetRange As Range
Dim insertedPicture As Shape
If TypeName(Selection) <> "Range" Then
MsgBox "1枚目を貼り付けるセルを選択してください。", vbExclamation
Exit Sub
End If
folderPath = SelectImageFolder()
If Len(folderPath) = 0 Then Exit Sub
fileCount = GetImageFileNames(folderPath, fileNames)
If fileCount = 0 Then
MsgBox "対象の画像ファイルが見つかりませんでした。", vbExclamation
Exit Sub
End If
SortFileNames fileNames
Set startCell = ActiveCell
If startCell.Row + (fileCount - 1) * ROW_STEP > _
startCell.Worksheet.Rows.Count Then
MsgBox "写真数が多く、指定した行間隔ではシート内に収まりません。" & vbCrLf & _
"ROW_STEPまたは開始位置を確認してください。", vbExclamation
Exit Sub
End If
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
For i = 1 To fileCount
Application.StatusBar = _
"写真を貼り付けています。" & _
i & " / " & fileCount
Set targetRange = _
startCell.Offset((i - 1) * ROW_STEP, 0).MergeArea
Set insertedPicture = AddPictureToRange( _
filePath:=folderPath & _
Application.PathSeparator & _
fileNames(i), _
targetRange:=targetRange, _
marginPt:=PHOTO_MARGIN)
processedCount = processedCount + 1
Next i
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox processedCount & _
"枚の写真を貼り付けました。", _
vbInformation
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox processedCount & _
"枚まで貼り付けたところで処理を停止しました。" & _
vbCrLf & _
Err.Description, _
vbExclamation
End Sub
Private Function SelectImageFolder() As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "画像が保存されているフォルダを選択"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function
SelectImageFolder = .SelectedItems(1)
End With
End Function
Private Function GetImageFileNames( _
ByVal folderPath As String, _
ByRef fileNames() As String) As Long
Dim fileName As String
Dim extension As String
Dim count As Long
fileName = _
Dir(folderPath & _
Application.PathSeparator & _
"*.*")
Do While Len(fileName) > 0
If InStrRev(fileName, ".") > 0 Then
extension = _
LCase$(Mid$(fileName, _
InStrRev(fileName, ".") + 1))
Select Case extension
Case "jpg", "jpeg", "png", "bmp"
count = count + 1
ReDim Preserve _
fileNames(1 To count)
fileNames(count) = fileName
End Select
End If
fileName = Dir()
Loop
GetImageFileNames = count
End Function
Private Sub SortFileNames( _
ByRef fileNames() As String)
Dim i As Long
Dim j As Long
Dim temporaryName As String
For i = LBound(fileNames) _
To UBound(fileNames) - 1
For j = i + 1 _
To UBound(fileNames)
If StrComp( _
fileNames(i), _
fileNames(j), _
vbTextCompare) > 0 Then
temporaryName = fileNames(i)
fileNames(i) = fileNames(j)
fileNames(j) = temporaryName
End If
Next j
Next i
End Sub
処理中はExcelのステータスバーへ「3 / 20」のように進捗を表示します。
また、途中でエラーが発生した場合も画面更新とステータスバーを元へ戻し、何枚目まで正常に処理できたかを表示します。
写真枠の間隔に合わせてROW_STEPを変更する
一括処理で最初に確認するのが、次の数値です。
Const ROW_STEP As Long = 12これは、次の写真枠まで何行移動するかを表します。
| 1枚目 | 2枚目 | ROW_STEP |
|---|---|---|
| B2 | B14 | 12 |
| B2 | B17 | 15 |
| C5 | C15 | 10 |
自社の写真台帳で、1枚目と2枚目の写真枠の先頭行が何行離れているかを確認し、その数字へ変更してください。
横方向へ並べたい場合は、Offsetの列方向も変更する必要があります。
ファイル名は001、002のように桁数を揃える
今回のコードでは、ファイル名を文字列として並べ替えています。
そのため、次のようなファイル名には注意してください。
| ファイル名 | 文字列として並べた結果 |
|---|---|
| 1.jpg | 1番目 |
| 10.jpg | 2番目 |
| 2.jpg | 3番目 |
撮影順に並べたい場合は、最初から桁数を揃える方法が簡単です。
| 避けたい名前 | おすすめ |
|---|---|
| 1.jpg | 001.jpg |
| 2.jpg | 002.jpg |
| 10.jpg | 010.jpg |
「001_着工前.jpg」「002_施工中.jpg」「003_完成.jpg」のように連番を先頭へ付けておけば、撮影内容も確認しやすくなります。
一括処理を再実行すると写真は追加される
今回のコードでは、同じ写真枠に既存写真があるかどうかを判定していません。
そのため、一括処理を同じ開始位置から再実行すると、新しい写真が既存写真の上へ追加されます。
本番ファイルで何度も実行しないでください。
まずテスト用コピーで1回実行し、貼り付け位置と写真枚数を確認します。再実行する場合は、既存写真を削除してよいか確認してから行いましょう。
既存画像を自動削除するコードも作れますが、帳票内のロゴや説明用画像まで誤って削除する可能性があります。
業務用ファイルでは、画像へ専用の名前や識別情報を付けてから差し替える設計の方が安全です。
工事写真台帳や報告書へ応用する方法
写真台帳では、画像を貼るだけでなく、写真に関する情報も一緒に記録すると入力作業を減らせます。
- 画像ファイル名を説明欄へ転記する
- 撮影番号を連番で入力する
- 写真枚数を集計する
- ページ単位で貼り付け先を切り替える
- 処理したフォルダ名を管理用シートへ記録する
- 実行日時を記録する
撮影日時やカメラ情報などのExifデータを取得したい場合は、画像挿入とは別の処理が必要です。
画像形式や撮影端末によって保持されている情報も異なるため、提出書類へ利用する場合は取得結果を実データと照合してください。
スタック写真台帳の自動化では、速く貼れることだけでなく「写真が抜けていないか」を確認できることが重要です。元フォルダの画像数と貼り付け枚数を最後に照合する運用をおすすめします。
完成した写真台帳を毎回印刷・PDF化している場合は、Excelマクロで印刷ボタンを作る方法も組み合わせると、帳票作成後の操作まで標準化できます。
大量の写真でExcelが重くなる場合の対策
写真をセルサイズまで縮小したからといって、Excelファイルの容量が同じ割合で小さくなるわけではありません。
今回のマクロで変更しているのは、主にシート上で表示するShapeの幅と高さです。
高解像度の写真を大量にブックへ保存する場合は、写真そのものの容量対策も行いましょう。
- 貼り付け前に画像サイズを用途に合わせて縮小する
- Excelの「画像の圧縮」を利用する
- 提出用と原本写真の保管場所を分ける
- 1つのブックへ入れる写真枚数を増やしすぎない
- 現場・案件・月ごとにブックを分ける
- 処理前後のファイル容量を確認する
| 方式 | メリット | 注意点 |
|---|---|---|
| 画像をブックへ保存 | Excelファイル単体で写真を表示しやすい | 写真が増えるほど容量が増えやすい |
| 元画像へリンク | ブック容量を抑えやすい | 画像移動やアクセス権変更でリンク切れする可能性がある |
社外へ提出するExcelや、ほかのパソコンへ移動するファイルでは、元写真へのリンクに依存しない方が扱いやすい場合があります。
一方、数百枚・数千枚の写真をExcelへすべて埋め込む設計も現実的とは限りません。
大量の写真を扱う場合は、ファイル分割や専用サービスも含めて検討してください。
MicrosoftサポートでOffice画像の圧縮方法を確認する
写真貼り付けマクロが動かないときの確認項目
エラーが発生した場合は、何度もマクロを実行する前に原因を切り分けましょう。
| 症状 | 確認すること |
|---|---|
| マクロ一覧に表示されない | 標準モジュールへPublic Subとして作成したか確認する |
| コードが保存されない | .xlsm形式で保存しているか確認する |
| マクロを実行できない | デスクトップ版Excelか、会社のセキュリティ設定で制限されていないか確認する |
| 写真を選んでも挿入できない | 対象拡張子か、元画像自体を正常に開けるか確認する |
| 結合セルへ正しく入らない | 写真枠内の1セルをActiveCellとして選択しているか確認する |
| 写真が枠からはみ出す | セルの幅・高さとPHOTO_MARGINを確認する |
| 写真が同じ場所へ重なる | ROW_STEPが写真枠の間隔と合っているか確認する |
| 途中で一括処理が止まる | 表示された処理済み枚数から問題の画像を確認する |
| シートへ画像を追加できない | ワークシートが保護されていないか確認する |
| 最後の写真でエラーになる | ROW_STEPによってシート最終行を超えていないか確認する |
| ブックが極端に重くなる | 元画像の解像度、枚数、画像圧縮、ブック容量を確認する |
F8キーで1行ずつコードを確認する
どの処理でエラーが起きているか分からない場合は、Visual Basic Editorで対象マクロ内へカーソルを置き、Windows版ではF8キーを使って1行ずつ処理できます。
停止した行を確認し、次の内容を調べてください。
filePathに正しい画像パスが入っているかtargetRangeが意図したセルかmaxWidthとmaxHeightが0以下になっていないか- 画像ファイルが破損していないか
- シートが保護されていないか
実務で使える別のVBAサンプルも確認したい方は、エクセル便利マクロ集8選も参考にしてください。
この記事のコードを自社の帳票に合わせて変更したり、エラーを自分で直したりするには、変数・条件分岐・繰り返し処理・デバッグなどVBAの基礎を理解しておくと応用しやすくなります。
独学で断片的に覚えるより体系的に学びたい方は、初心者向け・実務向け・ChatGPT活用まで目的別に比較した記事を参考にしてください。
Excelマクロと写真台帳アプリのどちらを選ぶべきか
既存のExcel帳票へ数枚から数十枚の写真を貼り付ける程度なら、VBAは有力な選択肢です。
特に、会社指定のExcel様式があり、「写真の貼り付けだけを効率化したい」という用途なら、既存帳票をそのまま使えるメリットがあります。
一方、現場で多数の写真を撮影し、複数人で共有・承認・検索・進捗管理まで行う場合は、Excelへ機能を追加し続けるより専用サービスを比較した方が管理しやすいことがあります。
| 方法 | 向いているケース | 注意点 |
|---|---|---|
| Excel VBA | 既存Excel帳票へ写真を配置する | コードの保守とブック容量に注意する |
| 写真台帳アプリ | 撮影から台帳作成まで現場で行う | 対応帳票やデータ出力方法を確認する |
| クラウド型サービス | 複数人で共有・承認・履歴を管理する | 料金、権限、通信環境、保存先を確認する |
VBAが得意なのは、セル、シート、図形、印刷など既存Excel帳票の細かな操作です。
画像以外のデータ集計、Web操作、大量ファイル処理、複数人による重要業務まで自作する場合は、VBA以外の方法も比較してください。
VBA、Power Query、Power Automate、Python、SaaSのどれを選ぶか迷う場合は、Excel自動化の例7選と選び方で業務別に整理しています。
既存マクロが増え、作成者しか直せない状態になっている場合は、VBAを続ける業務と別の方法へ移行する業務の判断基準も確認してください。
エクセルの写真貼り付けマクロに関するよくある質問
まとめ｜写真貼り付けはVBAで安全に自動化する
Excelへ写真を自動サイズ調整して貼り付ける基本は、次の4つです。
Shapes.AddPictureで画像を挿入するLockAspectRatioで縦横比を維持するActiveCell.MergeAreaで写真枠全体を取得する- セルと写真の幅・高さの差を2で割って中央配置する
写真が数枚なら1枚用コード、同じ形式の写真枠へ繰り返し配置するならフォルダ一括処理を使い分けてください。
また、一括処理では「速く貼り付けられたか」だけでなく、元フォルダの写真枚数、貼り付け枚数、並び順まで確認しましょう。
自動化の目的はクリック数を減らすことではなく、誰が処理しても写真の抜け・歪み・配置ミスが起きにくい状態を作ることです。
写真貼り付け以外にも、ファイル結合、帳票作成、PDF保存などを効率化したい場合は、作業内容に合う方法を比較してください。
＼ VBAを基礎から実務レベルまで学ぶ ／
VBA以外の自動化方法も比較したい方は、Excel自動化7選も参考にしてください。
VBAの動作や利用可能な機能は、Excelのバージョン、OS、組織のセキュリティ設定によって異なる場合があります。重要な業務へ適用する前に、コピーしたファイルとテスト用画像で動作を確認してください。
