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

 

写真編集作業にめちゃくちゃ時間がかかる。。。シートに大量の写真をまとめて貼り付けたい！

 

こんな問題は『写真を貼り付けるマクロ』で解決できます。

 

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

 

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

↓

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

↓

③実行ボタンを押下

 

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

 

 

 

 

 

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

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

 

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

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

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

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

 

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

 

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

 

 

これらの設定はVABコードを修正することで変更可能です。

 

例えば、

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

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

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

 

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

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

 

 

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

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

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

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

 

様式の作成

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

 

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

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

 

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

 

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

 

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

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

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

 

「設定」シートの作成

 

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

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

 

 

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

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

 

ユーザーフォームの作成

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

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

 

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

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

 

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

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

 

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

 

関連記事「Callの使い方」では、別のマクロを呼び出す方法が紹介されています。

ユーザーフォームを表示したり非表示にしたりするVBAコードがこちら

 

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

Private Sub WorkSheet_Activate()
UserForm1.Hide
UserForm2.Hide
End Sub

 

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

Private Sub WorkSheet_Activate()
UserForm1.Show vbModeless
UserForm2.Hide
End Sub

 

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

Private Sub WorkSheet_Activate()
UserForm1.Hide
UserForm2.Show vbModeless
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を写真の名前の表示で使用する様式はいろんな仕事で応用しやすい！評判です。

 

 

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

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

 

 

 

 

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

 

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

 

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

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

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

 

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

 

例えばこんな感じ

 

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

 

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

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

 

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

 

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

 

 

VBAでエクセル業務の効率化を実現

VBAを活用することで、エクセルでの日常業務を劇的に効率化できます。

VBAを使えば、

繰り返し作業の自動化によって人的ミスを削減し、作業時間を大幅に短縮する

ことが可能です。

 

毎日行っているデータ集計やレポート作成を自動化すれば、数時間かかっていた作業がボタン一つで数分で完了します。

エクセル作業が多い環境ではVBAの導入は必須事項である！といっても過言ではありません。

 

マクロを導入するメリット

マクロを導入する最大のメリットは、作業時間の短縮と品質の向上を同時に実現できることです。

人間が時間をかけて行う単純作業をコンピュータが正確かつ高速に処理することができます。

 

たとえば、手作業で1時間かかっていたデータ整理が、マクロなら数秒で完了し、さらに計算ミスや入力間違いも完全に防げます。

また、一度作成したマクロは何度でも使い回せるため、長期的な業務効率化投資としても非常に価値があります。

 

結果として、マクロ導入は時間コストの削減と業務品質の向上という二重のメリットをもたらします。

 

VBA学習の始め方

VBA学習の最も効果的な始め方は、実際の業務課題から出発することです。

目的が明確な学習は記憶定着率が高く、モチベーションも維持しやすいのは間違いありません。

 

たとえば、毎週行っているデータ集計作業を自動化することを目標に設定し、必要な機能から順番に覚えていけば実践的なスキルがすぐに身につきます。

 

基本的な変数の使い方から始まり、ループ処理、条件分岐、配列など、段階的にレベルアップしていくことで、確実にVBAをマスターできます。

 

関連記事「VBA初心者必見！マクロの作り方」では、コードを書く画面の開き方や書いたコードの実行方法が図やサンプルコードを使って紹介されています。

 

マクロの開発を外注依頼する

業務内容に合わせた効率化マクロを導入したいけど、VBAコードを開発する時間がない。。。どうやってプログラムを組めばいいかわからない。。。

 

このような方は、マクロ開発を外注に依頼しちゃいましょう。

 

外注依頼することで本業に集中しながら高品質なマクロを即座に導入することができます。

 

ちなみに、マメBlogでもエクセルマクロ開発代行サービスを承っています。

開発内容の確認、VBAコードの設定、動作確認後の調整、など全ての工程を私（マメ父ちゃん）が行っているので、

費用が安い！スピード納期！！

でやらせてもらっています。

 

ほとんど独学で身に付けたVBAスキルなので、内容によっては開発できないこともあるのでご了承ください。

 

ご相談、見積もり依頼は完全無料ですので気になる方は下記のリンクよりお問合せ下さい。

 

 

 

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