エクセルで写真の貼り付けを自動化するマクロ【すぐに使えるサンプル付】　

エクセルに大量の写真をまとめて貼り付けたい！

こんな要望にエクセルマクロを使ってお応えします。

この記事で紹介している写真を貼り付けるマクロがこちら

①いつも通り写真をフォルダに保存

↓

②フォルダの保存場所を記入

↓

③実行ボタンを押下

たったの3Stepで大量の写真をまとめてエクセルに貼り付けることが可能となります。

今まで1時間以上かかっていたのに数分で処理できるようになった
大きさ、配置が自動的に調整されるのでキレイな資料を作れるようになった
写真付の資料作成が楽になった

ガッツポーズの人

かなり評判のいいマクロです。

この記事では、写真を貼り付けるマクロの導入方法、使い方、ダウンロードの方法を紹介しています。

よくエクセルに写真を貼り付ける作業をしている！という方は是非参考にしてみてください。

1 写真を貼り付けるマクロとは？
2 写真を貼り付けるマクロの導入方法
3 写真を貼り付けるマクロの使い方
4 エクセルに写真をまとめて貼り付けるマクロはデスクワークで効果的
5 なんとしても写真を貼り付けるマクロを使いたい方へ
- 5.1 写真の貼り付けマクロをダウンロードする
- 5.2 写真を貼り付けるマクロの作成依頼

写真を貼り付けるマクロとは？

写真を貼り付けるマクロとは、

指定するフォルダ内にある全ての写真データをエクセルに貼り付ける

という処理を自動化するプログラムのことです。

下記の動画では写真を貼り付けるマクロの動きや使い方を詳しくご紹介しています。

今回ご紹介している「写真を貼り付けるマクロ」の設定がこちら

A4用紙(タテ)に3枚分の写真を貼り付ける
貼り付けた写真の横に写真名を表示する
指定するフォルダ内全ての写真を貼り付ける

これらの設定は写真を貼り付けるマクロのコードを修正することで変更可能です。

例えば、

貼り付ける写真を3枚ではなく6枚に変更したい

写真名ではなく撮影日を表示したい

など、業務内容に応じた処理に変更することができます。

拒否する人

コードの修正作業はちょっとできないかも。。

このように感じた方は記事の後半で紹介している「写真を貼り付けるマクロの作成依頼」を参考にしてみてください。

写真を貼り付けるマクロを開発した私がどのような処理を実現したいのか聞き取りを行い最適なマクロをご提案します。

写真を貼り付けるマクロの導入方法

写真を貼り付けるマクロを導入に手順がこちら

様式の作成
「設定」シートの作成
ユーザーフォームの作成
マクロの登録

一つ一つ詳しく解説していきます。

様式の作成

コードを作り始める前に、様式の設定をしっかり行う必要があります。

様式設定で抑えておくべき3つのポイント

大きさを揃える
配置を揃える
印刷範囲を意識する

これらのポイントをしっかり抑えておくことでキレイな資料を作成することができます。

横向きの写真を挿入する様式

行の高さを｢13.5｣
列の幅を｢2｣
ページの縮小を100％
ページの向きを「縦」
上図のようにセルを結合する

縦向きの写真を挿入する様式

行の高さを｢2｣
列の幅を｢13.5｣
ページの縮小を100％
ページの向きを「横向き」
上図のようにセルを結合する

今回の様式設定は、A4用紙に写真がちょうど3枚入る！という設定です。

「写真添付」という箇所に写真が添付されていき、挿入された写真の名前が「写真の名前」に表示されます。

※写真の大きさの調整は縦横比を変更しない設定で、セルの高さにぴったり合うように設定されています。そのため写真の横幅とセルの横幅がずれることがあります。

「設定」シートの作成

上図のように設定シートを作成します。

A3セルに入力されたテキストからフォルダの場所を読み取る！という仕組みです。

ひらめく人

A3セル以外のセルは基本的に操作しない！という意味で背景色を黄色にしています。

シート名を「設定」にしてください。シートを区別するマクロが使われているため「設定」にしなければ正常動作しません。

これで設定シートの作成は完了です。

ユーザーフォームの作成

今回は、ユーザーフォームのボタンをクリックすることでマクロが実行されるという仕組みを採用しているので、

VBAでユーザーフォームを作成する必要があります。

写真(横)シートに表示するユーザーフォーム

1	Private Sub CommandButton1_Click()
2	Call 写真挿入横
3	End Sub

写真(縦)シートに表示するユーザーフォーム

1	Private Sub CommandButton1_Click()
2	Call 写真挿入縦
3	End Sub

Callで標準モジュールで作成したマクロを呼び出しています。

設定シートでユーザーフォームを表示するマクロ

1	Private Sub WorkSheet_Activate()
2	UserForm1.Hide
3	UserForm2.Hide
4	End Sub

写真(横)シートでユーザーフォームを表示するマクロ

1	Private Sub WorkSheet_Activate()
2	UserForm1.Show vbModeless
3	UserForm2.Hide
4	End Sub

写真(縦)シートでユーザーフォームを表示するマクロ

1	Private Sub WorkSheet_Activate()
2	UserForm1.Hide
3	UserForm2.Show vbModeless
4	End Sub

シートを切り替えることでユーザーフォームが起動する設定にしています。この設定は、間違ってユーザーフォームを閉じてもシートを切り替えるだけで再表示することができるので、感覚的に扱うことができます。

コードの作成

VBA編集画面で「Module」を作成

「Module1」にサンプルコードを記入

サンプルコード①

このサンプルコードは「写真(横)」シート用のコードです。


Sub 写真挿入横()
    Dim Ash As Worksheet
    Set Ash = Sheets("設定")
    Dim Csh As Worksheet
    Set Csh = Sheets("写真(横)")
    Const cnsTitle = "ファイル名一覧取得"
    Const cnsDIR = "\*.*"
    Dim xlAPP As Application
    Dim strPath, strFilename, myFileName, syasin, Path As String
    Dim GYO, rx As Long
    Dim zukei As Shape
    ' 写真(横)シートの25列目最終行数を変数rxに格納
    rm = Csh.Cells(Rows.Count, 25).End(xlUp).Row
    ' 写真(横)シートの全ての写真を削除
    For Each sa In Csh.Shapes
    On Error Resume Next
    If sa.TopLeftCell.Address >= Csh.Cells(100, 1).Address Then
    sa.Delete
    End If
    If Err <> 0 Then
    Err.Clear
    End If
    Next
    ' 写真(横)シートの25列目に記入されている写真データ名を削除
    For i = 3 To rm Step 21
    Csh.Range(Csh.Cells(i, 25), Csh.Cells(i + 2, 38)).ClearContents
    Next
    Set xlAPP = Application
    ' フォルダの場所を指定する
    strPath = Ash.Cells(3, 1)
    ' フォルダの存在確認 --- 必要な場合のみ記述 ---
    If Dir(strPath, vbDirectory) = "" Then
        MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTitle
    Exit Sub
    End If
    ' 先頭のファイル名の取得
    strFilename = Dir(strPath & cnsDIR, vbNormal)
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFilename <> ""
        ' 行を加算
        GYO = GYO + 21
        Csh.Cells(GYO - 18, 25).Value = strFilename
        ' 次のファイル名を取得
        strFilename = Dir()
    Loop
     ' 写真(横)シートの25列目最終行数を変数rxに格納
    rm = Csh.Cells(Rows.Count, 25).End(xlUp).Row
    For i = 1 To rm Step 21
    '変数syasinに貼り付ける写真データ情報を格納
    syasin = Ash.Cells(3, 1) & "\" & Csh.Cells(i + 2, 25).Value
    'AddPictureで写真を貼り付ける
    Set zukei = Csh.Shapes.AddPicture(Filename:=syasin, LinkToFile:=False, SaveWithDocument:=True, Left:=0, Top:=0, Width:=0, Height:=0)
        With zukei
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .LockAspectRatio = msoTrue
        '''''''''''''''''''''ここの数値を変更することで写真の大きさ、配置を変更できる''''''''''''''''''''''''''
        .Height = Csh.Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Height
        rx = (Csh.Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Width - .Width) / 2
        .Left = Csh.Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Left + rx
        .Top = Csh.Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Top
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        End With
    Next i
End Sub

サンプルコード②

このサンプルコードは「写真(縦)」シート用のコードです。


Sub 写真挿入縦()
    Dim Ash As Worksheet
    Set Ash = Sheets("設定")
    Dim Csh As Worksheet
    Set Csh = Sheets("写真(縦)")
    Const cnsTitle = "ファイル名一覧取得"
    Const cnsDIR = "\*.*"
    Dim xlAPP As Application
    Dim strPath, strFilename, myFileName, syasin, Path As String
    Dim RETU, retum, rx As Long
    Dim zukei As Shape
     ' 写真(縦)シートの3行目最終行数を変数retumに格納
    retum = Csh.Cells(3, Columns.Count).End(xlToLeft).Column
    ' 写真(縦)シートの全ての写真を削除
    For Each sa In Csh.Shapes
    On Error Resume Next
    If sa.TopLeftCell.Address >= Csh.Cells(1, 1).Address Then
    sa.Delete
    End If
    If Err <> 0 Then
    Err.Clear
    End If
    Next
    ' 写真(縦)シートの3行列目に記入されている写真データ名を削除
    For i = 2 To retum Step 17
    Csh.Range(Csh.Cells(3, i), Csh.Cells(6, i + 15)).ClearContents
    Next
    Set xlAPP = Application
    ' フォルダの場所を指定する
    strPath = Ash.Cells(3, 1)
    ' フォルダの存在確認 --- 必要な場合のみ記述 ---
    If Dir(strPath, vbDirectory) = "" Then
        MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTitle
    Exit Sub
    End If
    ' 先頭のファイル名の取得
    strFilename = Dir(strPath & cnsDIR, vbNormal)
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFilename <> ""
        ' 列を加算
        RETU = RETU + 17
        Csh.Cells(3, RETU - 15).Value = strFilename
        ' 次のファイル名を取得
        strFilename = Dir()
    Loop
   retum = Csh.Cells(3, Columns.Count).End(xlToLeft).Column
   For i = 2 To retum Step 17
   syasin = Ash.Cells(3, 1) & "\" & Csh.Cells(3, i).Value
   
   Set zukei = Csh.Shapes.AddPicture(Filename:=syasin, LinkToFile:=False, SaveWithDocument:=True, Left:=0, Top:=0, Width:=0, Height:=0)
        With zukei
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .LockAspectRatio = msoTrue
        '''''''''''''''''''''ここの数値を変更することで写真の大きさ、配置を変更できる''''''''''''''''''''''''''
        .Height = Csh.Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Height
        rx = (Csh.Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Width - .Width) / 2
        .Left = Csh.Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Left + rx
        .Top = Csh.Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Top
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        End With
   Next i
End Sub

これでエクセルに自動的に写真を貼りつけるマクロの設定が完了です。

写真を貼り付けるマクロの使い方

写真を貼り付けるマクロの使い方としては、「フォルダに写真を保存」「フォルダの場所を指定」「マクロの実行」の3Stepです。

一つ一つ詳しく解説していきます。

貼り付ける写真を保存するフォルダを作成する

保存場所はどこでもいいので写真保存用のフォルダを作成します。

フォルダ内のすべての写真を貼り付けるコードなのでエクセルに張り付けない不要な写真は保存しないよう注意してください。

｢設定｣シートでフォルダの場所を入力する

「設定」シートのA3セルにフォルダの場所を記入してください。

A3セル以外のセルは編集不要という意味でA3セル以外のセルの背景色を黄色にしています。

写真を貼り付けるマクロを実行する

ユーザーフォームの「実行」ボタンを押下して設定したマクロを実行してください。

ユーザーフォームはシートを選択すると表示される設定になっています。

なので、｢写真(横)｣シートでは横写真用のユーザーフォームが表示され、｢写真(縦)｣シートでは縦写真用のユーザーフォームが表示されます。

以上の手順で写真を貼り付けるマクロを使うことができます。

エクセルに写真をまとめて貼り付けるマクロはデスクワークで効果的

今回紹介した写真を貼り付けるマクロは写真添付が必要な資料作成にめちゃくちゃ効果的！です。

キレイな資料になる
写真挿入後の編集がやりやすい
写真を挿入するだけで書類として使える

以下のようなA4用紙に写真が3枚、右側3分の1を写真の名前の表示で使用する様式はいろんな仕事で応用しやすい！評判です。

写真の補足説明や注意事項を入力するために「ファイル名表示」の下はわざと空欄を作っています。

今回紹介しているマクロではファイル名にファイル形式が表示されます。

ガッツポーズの人

ファイル形式（.jpg)を非表示にすることも可能です。

もし、マクロを使わず手作業で写真貼り付け作業を行う2倍、3倍の時間が必要になります。

疲れ果てた人

めちゃくちゃ大きいサイズの写真が重なって表示されてしまう

このように写真をまとめて挿入すると、この後の編集にかなり時間がかかります。

大きさを編集
表示位置を編集
名前を付ける
全体を揃える

今回紹介するマクロを使えば、

時間のかかる編集作業を一瞬で処理することができ編集ミスがなくなる！

というメリットがあります。

今回はよく使われるA4用紙に3枚の写真を貼り付ける様式でマクロを設定していますがいろんな様式にアレンジすることができます。

例えばこんな感じ

写真を貼り付ける場所、写真の大きさがあらかじめ決まっていればどんな様式にも対応可能です。

デスクワークでは毎日のようにエクセルに写真を貼りつけて編集する作業があります。

作業内容は大量の写真を印刷範囲内にキレイに貼り付ける！です。誰にでもできる単純作業なのに時間ばかりかかってしまう！という問題がありました。

こんな問題を解決するために、写真を貼りつけるマクロを開発

マクロを導入してからは作業の効率が格段に上がり、また資料の完成度に個人差がなくなった！という別のメリットも発生しました。

ガッツポーズの人

作業効率アップ！資料の完成度アップ！間違いなしのマクロです。

なんとしても写真を貼り付けるマクロを使いたい方へ

写真の貼り付けマクロをなんとしても導入したい！でも様式とコードを設定するのは難しい。。

このように、マクロには興味あるけど導入に苦戦している！という方に２つの導入方法をご紹介します。

写真の貼り付けマクロが設定されたエクセルファイルをダウンロードする
業務内容に合った写真の貼り付けマクロを開発依頼する

この２つの方法は難しいコードの編集や様式設定が不要なので誰でも簡単に写真を貼り付けるマクロを導入することが可能です。

写真の貼り付けマクロをダウンロードする

この記事でご紹介した「写真を貼り付けるマクロ」が設定されたエクセルファイルを下記のサイトでダウンロードすることができます。

「写真を貼り付けるマクロ」のダウンロードはこちら

A4サイズに3枚の写真を貼り付ける様式でいいからすぐにマクロを使ってみたい！という方におすすめです。

写真を貼り付けるマクロの作成依頼

写真を貼り付けるマクロの作成依頼では、業務内容に合わせた処理を行うマクロを設定することができます。

ガッツポーズの人

写真を貼り付けるマクロをオーダーメイドする！というイメージです。

依頼方法は、

どんな処理を自動化したいのか！を伝える

たったこれだけです。

例えばこんな感じ

仕事で使っているエクセルの様式に写真を貼り付けたい
保存されている順番通りに写真を貼り付けたい
写真の貼り付けと同時に日付や解説などのテキストを表示させたい

指示して頂いた情報から最適のマクロを開発し提出させていただきます。

マクロの開発依頼についてもっと詳しく知りたい！という方は下記の「送信フォーム」からマメBlogへお問合せください。

送信フォームはこちら

マクロを使ってエクセル業務の効率をアップさせましょう。

エクセル

Posted by t.a.k.ubonse926@gmail.com

エクセルマクロの作成を代行【実例と注文方法を紹介】

【エクセルで図形の編集ができない？】簡単に図形を編集するテクニックやマクロを紹介

コメント一覧

平野宏宗より:
2021年5月10日 2:30 PM
始めまして
平野です。
この度、初めてnoteで購入しダウンロードをしてみたのですが
実行すると一時停止になってしまいます。
仕事で写真を取り込む作業が多い為、是非活用したいと思うのですが
何が原因か分からないです。
For i = 1 To rm Step 21
Csh.Cells(i + 2, 2).Select
syasin = “C:\Users\h-hirano\Desktop\写真注入” & Csh.Cells(i + 2, 25).Value
Csh.Pictures.Insert syasin　　←こちらが黄色になってます。
Csh.Pictures.Top = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Top
Csh.Pictures.Left = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Left
Csh.Pictures.Height = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Height
Next i
何卒宜しくお願い致します。
返信
ななしより:
2021年5月13日 6:02 PM
はじめまして。
16行目のコマンドだと画像複数の場合、画像一枚分しか貼られないようでした。マクロを2回実行したら複数枚いけました。
返信
- t.a.k.ubonse926@gmail.comより:
  2021年5月13日 7:09 PM
  はじめまして。
  マメBlogを閲覧していただきありがとうございます。
  貴重なコメントありがとうございます。
  私の方で検証した結果、ななしさんと同じ事象が発生するときと、発生しないときがありました。
  プログラムの見直しをしていきたいと思います。
  ありがとうございました。
  返信