エクセル写真貼り付け自動サイズ調整マクロ｜結合セル・一括処理対応

2026年6月27日2026年7月29日

こんにちは、SkillStack Lab運営者のスタックです。

工事写真台帳や報告書を作るたびに、Excelへ写真を1枚ずつ貼り付け、セルの大きさに合わせて調整していませんか。

写真の縦横比が崩れたり、結合セルの中央からずれたり、画像が増えてブックが重くなったりすると、単純な貼り付け作業にも意外と時間がかかります。

結論から言うと、VBAで画像の縦横比を固定し、セルの幅と高さを比較してから中央位置を計算すれば、選択したセルへ写真を自動サイズ調整して配置できます。

この記事では、1枚の写真を貼り付けるコードに加えて、フォルダ内の複数画像をファイル名順に処理するコード、ファイル容量や実行エラーへの対策まで解説します。

Excelへの写真貼り付けで発生しやすい作業時間、画像の歪み、結合セル内の位置ずれ

この記事のVBAは、マクロを実行できるデスクトップ版Excelを前提にしています。Excel for the webではVBAマクロを作成・編集・実行できません。また、コードを試す前に元ファイルのコピーを保存し、マクロ有効ブック（.xlsm）として作業してください。

先に結論

1枚だけ貼るなら、最初に紹介するコードを使用する
結合セルでも、選択セルのMergeAreaを取得すれば対応できる
複数画像は、フォルダ取得・並べ替え・繰り返し処理を追加する
画像の表示サイズを小さくしても、元画像データが大きければブック容量は増える

この記事で分かること

写真をセルや結合セルへ自動サイズ調整して貼り付けるコード
画像の縦横比を維持し、中央へ配置する仕組み
フォルダ内の複数画像をファイル名順に貼り付ける方法
写真でExcelが重くなる場合やマクロが動かない場合の対策

エクセルに写真を貼り付けて自動サイズ調整するVBAコード

まずは、選択中のセルまたは結合セルへ写真を1枚挿入し、縦横比を維持したまま中央に配置するコードです。

元画像をブック内へ埋め込むため、画像ファイルを別の場所へ移動しても表示が消えにくい設定にしています。

Option Explicit

Private Const PHOTO_MARGIN As Double = 4

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

    Set targetRange = ActiveCell.MergeArea
    Set insertedPicture = AddPictureToRange( _
        filePath:=CStr(selectedFile), _
        targetRange:=targetRange, _
        marginPt:=PHOTO_MARGIN)

    MsgBox "写真を貼り付けました。", vbInformation

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

    maxWidth = targetRange.Width - marginPt * 2
    maxHeight = targetRange.Height - marginPt * 2

    If maxWidth <= 0 Or maxHeight <= 0 Then
        Err.Raise vbObjectError + 1000, , "貼り付け先のセルが小さすぎます。"
    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

End Function

PHOTO_MARGINは、写真とセル枠の間に設ける余白です。余白を広くしたい場合は、コード冒頭の「4」を「6」や「8」へ変更してください。

このコードはJPEG、PNG、BMPを対象にしています。HEICなどExcelが直接扱いにくい形式は、JPEGまたはPNGへ変換してから実行してください。

VBAコードを貼り付けて実行する手順

ファイルをコピーする
元のExcelファイルを残し、テスト用のコピーを作成します。
マクロ有効ブックで保存する
「名前を付けて保存」から、拡張子が「.xlsm」の形式を選びます。
VBEを開く
ExcelでAlt＋F11を押します。
標準モジュールを追加する
VBEの「挿入」から「標準モジュール」を選択します。
コードを貼り付ける
上のコードを、追加した標準モジュールへ貼り付けます。
写真枠を選択する
Excelへ戻り、写真を配置したいセルまたは結合セルをクリックします。
マクロを実行する
Alt＋F8を押し、PasteAndFitPictureを選択して実行します。

インターネットから取得したファイルや出所が分からないマクロは、内容を確認せずに有効化しないでください。会社の端末でマクロが制限されている場合は、セキュリティ設定を独断で変更せず、情報システム担当者へ確認しましょう。

参考：Microsoftサポート「Microsoft 365ファイルでマクロを有効または無効にする」

写真の縦横比を維持してセルへ収める仕組み

コードを自分の帳票に合わせて調整するために、重要な処理を順番に確認しておきましょう。

LockAspectRatioで写真の縦横比を固定する

セルの幅と高さを、そのまま写真の幅と高さへ設定すると、写真が縦長または横長に変形します。

コード内の次の行で、サイズ変更後も元画像の縦横比を維持します。

.LockAspectRatio = msoTrue

そのうえで、セル内に収まる幅と高さを比較し、先に上限へ達する方を基準にサイズを調整します。

貼り付け先の幅と高さを取得する
写真の幅と高さを取得する
横方向と縦方向の拡大・縮小率を比較する
枠からはみ出さない方のサイズを設定する

この方法では、写真全体を切らずに枠内へ収めるため、セルと写真の比率が異なる場合は上下または左右に余白が残ります。

MergeAreaで結合セル全体を取得する

写真台帳では、複数セルを結合して大きな写真枠を作ることがあります。

ActiveCell.MergeAreaを使うと、選択セルが含まれる結合範囲全体を取得できます。選択セルが結合されていない場合は、そのセル自体が対象になります。

参考：Microsoft Learn「Range.MergeAreaプロパティ」

写真をセルの中央へ配置する

サイズを調整した写真をセルの左上へ置くだけでは、余白が右側や下側へ偏ります。

左右と上下の余白を2で割り、その分だけ写真の開始位置を移動することで中央に配置できます。

左位置＝セルの左位置＋（セル幅 − 写真幅）÷ 2

上位置＝セルの上位置＋（セル高さ − 写真高さ）÷ 2

コードでは4ポイントの余白を差し引いているため、写真がセル枠へ密着しにくくなっています。

フォルダ内の複数画像をファイル名順に一括貼り付けする

写真が10枚、20枚と増える場合は、フォルダを選択し、画像ファイルを順番に読み込む処理を追加します。

次のコードは、最初に選択したセルから12行間隔で移動しながら、画像をファイル名順に貼り付けます。

次のコードは、先ほどのAddPictureToRange関数を使用します。1枚用のコードと一括処理用のコードを、同じ標準モジュールへ貼り付けてください。

Sub PasteFolderPictures()

    Const ROW_STEP As Long = 12
    Const MARGIN_PT As Double = 4

    Dim folderPath As String
    Dim fileNames() As String
    Dim fileCount As Long
    Dim i 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

    Application.ScreenUpdating = False
    On Error GoTo ErrorHandler

    For i = 1 To fileCount
        Set targetRange = startCell.Offset((i - 1) * ROW_STEP, 0).MergeArea

        Set insertedPicture = AddPictureToRange( _
            filePath:=folderPath & Application.PathSeparator & fileNames(i), _
            targetRange:=targetRange, _
            marginPt:=MARGIN_PT)
    Next i

    Application.ScreenUpdating = True
    MsgBox fileCount & "枚の写真を貼り付けました。", vbInformation
    Exit Sub

ErrorHandler:
    Application.ScreenUpdating = True
    MsgBox "処理を中止しました。" & 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

        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

        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

写真枠の間隔に合わせてROW_STEPを変更する

コード冒頭の次の部分は、写真を貼り付けるセルの行間隔です。

Const ROW_STEP As Long = 12

たとえば、1枚目の写真枠がB2、2枚目がB14なら12行間隔です。2枚目がB17なら、ROW_STEPを15へ変更します。

横方向へ並べる場合は、Offsetの第2引数を使用するようにコードを変更する必要があります。

ファイル名を001、002のように揃える

一括処理コードは、ファイル名を文字列として並べ替えます。

「1.jpg」「2.jpg」「10.jpg」のような名前では、「1.jpg」「10.jpg」「2.jpg」の順になる場合があります。

意図した順番を保つには、次のように桁数を揃えてください。

避けたい名前	推奨する名前
1.jpg	001.jpg
2.jpg	002.jpg
10.jpg	010.jpg

撮影順や工区順などの意味を持たせる場合は、「001_着工前.jpg」「002_施工中.jpg」のように番号を先頭へ付けると管理しやすくなります。

工事写真台帳や報告書へ応用する方法

写真台帳では、画像を貼るだけでなく、ファイル名や説明文を近くのセルへ転記すると入力作業を減らせます。

画像のファイル名を説明欄へ記録する
撮影順に写真枠へ配置する
ページ単位で写真の貼り付け位置を変更する
貼り付けた写真の枚数を確認する
対象フォルダや処理日時を管理用シートへ残す

撮影日時などのExif情報を取得する場合は、画像貼り付けとは別の処理が必要です。撮影端末や画像形式によって取得できる情報も異なるため、業務で使用する前に実データ以外で確認してください。

元情シス・管理部門長としての注意点

写真台帳を自動化するときは、処理速度だけでなく、写真の欠落や順番の誤りを発見できる仕組みも必要です。

実行後に「元フォルダの画像数」と「Excelへ貼り付けた画像数」を照合し、提出前には目視確認を行いましょう。

大量の写真でExcelが重くなる場合の対策

写真の表示サイズをセルに合わせて小さくしても、元の画像データがブック内に保存されていれば、ファイル容量が同じ割合で小さくなるわけではありません。

高解像度の写真を大量に埋め込む場合は、次の対策を検討してください。

貼り付け前に、画像の縦横サイズや解像度を用途に合わせて下げる
Excelの「画像の圧縮」機能を使用する
提出用と原本保管用のファイルを分ける
1ブックに含める写真数を制限し、現場や日付ごとに分ける
画像を追加する前後でブック容量を確認する

貼り付け方式	利点	注意点
ブックへ埋め込む	Excelファイルだけで画像を表示しやすい	写真が増えるとブック容量も増えやすい
元画像へリンクする	ブック容量を抑えやすい	画像の移動やアクセス制限により表示できなくなることがある

社外へ提出するExcelや、別のパソコンへ移動する可能性があるファイルでは、リンク切れを避けるため埋め込みの方が扱いやすい場合があります。

参考：Microsoftサポート「Microsoft Officeの画像ファイルサイズを小さくする」

写真貼り付けマクロが動かないときの確認項目

エラーが発生した場合は、コードを繰り返し実行する前に、次の項目を確認してください。

症状	確認すること
マクロ一覧に表示されない	標準モジュールへ貼り付けたか、ファイルを.xlsmで保存したか
マクロを実行できない	Excel for webではなくデスクトップ版か、会社の設定で制限されていないか
写真を選んでも挿入されない	対応する拡張子か、画像ファイルを別のアプリで開けるか
写真が枠からはみ出す	貼り付け先のセル、結合範囲、余白設定が正しいか
同じ位置へ写真が重なる	一括処理の`ROW_STEP`が帳票の行間隔と合っているか
ブックが極端に重い	元画像の解像度、枚数、埋め込み後の容量を確認したか

コードのどの行で止まっているか分からない場合は、VBEで処理を選択し、F8キーを押して1行ずつ実行します。

エラーが出た行を確認し、ファイルパス、対象セル、画像形式など、該当する変数の内容を調べましょう。

VBAの基本操作やデバッグ方法から学び直したい方は、UdemyのVBAおすすめ講座3選｜初心者・実務・ChatGPT活用で比較も参考にしてください。

Excelマクロと写真台帳アプリのどちらを選ぶべきか

既存のExcel帳票へ数枚から数十枚の写真を貼り付ける程度なら、VBAは有力な選択肢です。

一方、複数人が現場で撮影し、写真の承認、共有、検索、履歴管理まで行う場合は、専用アプリやクラウドサービスも比較した方が運用しやすいことがあります。

方法	向いているケース	注意点
Excel VBA	既存帳票へ写真を貼り、個人または少人数で使う	作成者以外がコードを修正できるようにする必要がある
写真台帳アプリ	現場で撮影から台帳作成まで進めたい	対応帳票、料金、データ出力方法の確認が必要
クラウド型サービス	複数人で共有・承認・履歴管理したい	権限、保存場所、通信環境、契約条件の確認が必要