エクセルで写真の貼り付けを自動化するマクロ【すぐに使えるサンプル付】
エクセルで複数の写真をまとめて貼り付けたい！
こんな要望にお応えします。
この記事で紹介している、「写真を貼り付けるマクロ」を導入すれば、複数の写真をまとめてエクセルに貼り付けることが可能となります。
今まで1時間かけて写真の貼付け作業をしていた方でも、マクロを導入することで10分以内に作業を完了させることだって可能です。
エクセルに写真を貼り付けようとしたとき、写真の大きさが大きすぎたり、表示位置が上すぎたり、思い通りいかない経験をした方が多いと思います。
ダウンする人
このようなめんどくさくて難しい作業はマクロを使って自動化してしまうことがおすすめです。
例えば、A4サイズに写真3枚分のデータを均等に貼り付ける！みたいな設定をすることで、
写真データの大きさ、配置がキレイに揃った資料をい一瞬で作成することが可能となります。
私の仕事では、写真をエクセルに貼り付けて報告書を作成する業務が多いので今回紹介するマクロを頻繁に使っています。
ひらめく人
よくエクセルに写真を貼り付ける作業をしている！という方は是非参考にしてみてください。
目次
複数の写真をいっきに貼り付けるマクロとは？
複数の写真をいっきに貼り付けるマクロの動きや使い方を動画で紹介しています。
今回紹介するマクロを使えば、複数枚の写真をいっきにエクセルに貼り付けることができ、エクセル作業の効率をアップさせることができます。
私の仕事では、エクセルに写真を貼りつけて編集する作業がもの凄くあります。やってることは凄い単純で、誰にでもできる作業なのに時間ばかりかかってしまう！という問題がありました。
この問題を解決するために、エクセルに自動で写真を貼りつけてるマクロを開発しました。
マクロを導入してからは作業の効率が格段に上がり、また資料の完成度に個人差がなくなった！という別のメリットも発生しました
この記事では、複数の写真をいっきに貼り付けるマクロの導入の方法、使い方、サンプルコードを紹介しています。
エクセルに写真をいっきに貼り付けるマクロの導入方法
様式の作成
マクロを作り始める前に、様式の設定をしっかり行いましょう。
写真を貼りつけて、キレイな資料を作るには3つのポイントがあります。
- 大きさを統一する
- 配置を揃える
- 挿入した写真の名前を表示する
3つのポイントをクリアできるような様式を作成しましょう。
横向きの写真を挿入する様式
- 行の高さを｢13.5｣
- 列の幅を｢2｣
- ページの縮小を100％
- ページの向きを「縦」
- 上図のようにセルを結合する
縦向きの写真を挿入する様式
- 行の高さを｢2｣
- 列の幅を｢13.5｣
- ページの縮小を100％
- ページの向きを「横向き」
- 上図のようにセルを結合する
今回の様式設定は、A4用紙に写真がちょうど3枚入る！という設定です。
「写真添付」という箇所に写真が添付されていき、挿入された写真の名前が「写真の名前」に表示されます。
※写真の大きさの調整は縦横比を変更しない設定で、セルの高さにぴったり合うように設定されています。そのため写真の横幅とセルの横幅がずれることがあります。
「設定」シートの作成
上図のように設定シートを作成します。A3セルに入力されたテキストからフォルダの場所を読み取る設定です。A3セル以外のセルは基本的に操作しない！という意味で背景色を黄色にしています。
シート名を「設定」にしてください。シートを区別するマクロが使われているため「設定」にしなければ正常動作しません。
これで設定シートの作成は完了です。
ユーザーフォームの作成
ユーザーフォームのボタンをクリックすることでマクロが実行される方法を採用しています。
写真(横)シートに表示するユーザーフォーム
| 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 |
シートを切り替えることでユーザーフォームが起動する設定にしています。この設定は、間違ってユーザーフォームを閉じてもシートを切り替えるだけで再表示することができるので、感覚的に扱うことができます。
マクロの登録
この記事の最後に紹介しているサンプルマクロを貼り付けてください。
これでエクセルに自動的に写真を貼りつけるマクロの設定が完了です。
エクセルに写真を自動で貼り付けるマクロの使い方
挿入する写真を入れるフォルダを作成する
場所はどこでもいいので、挿入する写真をまとめるフォルダを作成します。
エクセルに写真を自動挿入するマクロは、作成したフォルダ内のすべての写真を挿入してくれます。なので、エクセルに張り付けない不要な写真は保存しないよう注意してください。
｢設定｣シートでフォルダの場所を入力する
上図のように挿入したい写真が入っているフォルダの場所をA3セルに入力。なお、A3セル以外のセルは編集不要という意味でA3セル以外のセルの背景色を黄色にしています。
マクロを実行する
ユーザーフォームはシートを選択すると表示される設定になっています。なので｢写真(横)｣シートでは横写真用のユーザーフォームが表示され、｢写真(縦)｣シートでは縦写真用のユーザーフォームが表示されます。
サンプルマクロ【横向きの写真用】
| 1 | Sub 写真挿入横() |
| 2 | Dim Ash As Worksheet |
| 3 | Set Ash = Sheets(“設定") |
| 4 | Dim Csh As Worksheet |
| 5 | Set Csh = Sheets(“写真(横)") |
| 6 | Const cnsTitle = “ファイル名一覧取得" |
| 7 | Const cnsDIR = “\*.*" |
| 8 | Dim xlAPP As Application |
| 9 | Dim strPath As String |
| 10 | Dim strFilename As String |
| 11 | Dim GYO As Long |
| 12 | Dim zukei As Shape |
| 13 | Dim myFileName As String |
| 14 | Dim syasin As String |
| 15 | Dim Path As String |
| 16 | rm = Csh.Cells(Rows.Count, 25).End(xlUp).Row |
| 17 | For Each sa In Csh.Shapes |
| 18 | On Error Resume Next |
| 19 | If sa.TopLeftCell.Address >= Csh.Cells(1, 1).Address Then |
| 20 | sa.Delete |
| 21 | End If |
| 22 | If Err <> 0 Then |
| 23 | Err.Clear |
| 24 | End If |
| 25 | Next |
| 26 | For i = 3 To rm Step 21 |
| 27 | Csh.Range(Csh.Cells(i, 25), Csh.Cells(i + 2, 38)).ClearContents |
| 28 | Next |
| 29 | Set xlAPP = Application |
| 30 | strPath = Ash.Cells(3, 1) |
| 31 | If Dir(strPath, vbDirectory) = “" Then |
| 32 | MsgBox “指定のフォルダは存在しません。", vbExclamation, cnsTitle |
| 33 | Exit Sub |
| 34 | End If |
| 35 | strFilename = Dir(strPath & cnsDIR, vbNormal) |
| 36 | Do While strFilename <> “" |
| 37 | GYO = GYO + 21 |
| 38 | Csh.Cells(GYO – 18, 25).Value = strFilename |
| 39 | strFilename = Dir() |
| 40 | Loop |
| 41 | For i = 1 To rm Step 21 |
| 42 | Csh.Cells(i + 2, 2).Select |
| 43 | syasin = Ash.Cells(3, 1) & “\" & Csh.Cells(i + 2, 25).Value |
| 44 | Csh.Pictures.Insert syasin |
| 45 | Csh.Pictures.Top = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Top |
| 46 | Csh.Pictures.Left = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Left |
| 47 | Csh.Pictures.Height = Range(Csh.Cells(i + 2, 2), Csh.Cells(i + 20, 23)).Height |
| 48 | Next i |
| 49 | End Sub |
サンプルマクロ【縦向きの写真用】
| 1 | Sub 写真挿入縦() |
| 2 | Dim Ash As Worksheet |
| 3 | Set Ash = Sheets(“設定") |
| 4 | Dim Csh As Worksheet |
| 5 | Set Csh = Sheets(“写真(縦)") |
| 6 | Const cnsTitle = “ファイル名一覧取得" |
| 7 | Const cnsDIR = “\*.*" |
| 8 | Dim xlAPP As Application |
| 9 | Dim strPath As String |
| 10 | Dim strFilename As String |
| 11 | Dim RETU As Long |
| 12 | Dim zukei As Shape |
| 13 | Dim myFileName As String |
| 14 | Dim syasin As String |
| 15 | Dim Path As String |
| 16 | retum = Csh.Cells(3, Columns.Count).End(xlToLeft).Column |
| 17 | For Each sa In Csh.Shapes |
| 18 | On Error Resume Next |
| 19 | If sa.TopLeftCell.Address >= Csh.Cells(1, 1).Address Then |
| 20 | sa.Delete |
| 21 | End If |
| 22 | If Err <> 0 Then |
| 23 | Err.Clear |
| 24 | End If |
| 25 | Next |
| 26 | For i = 2 To retum Step 17 |
| 27 | Csh.Range(Csh.Cells(3, i), Csh.Cells(6, i + 15)).ClearContents |
| 28 | Next |
| 29 | Set xlAPP = Application |
| 30 | strPath = Ash.Cells(3, 1) |
| 31 | If Dir(strPath, vbDirectory) = “" Then |
| 32 | MsgBox “指定のフォルダは存在しません。", vbExclamation, cnsTitle |
| 33 | Exit Sub |
| 34 | End If |
| 35 | strFilename = Dir(strPath & cnsDIR, vbNormal) |
| 36 | Do While strFilename <> “" |
| 37 | RETU = RETU + 17 |
| 38 | Csh.Cells(3, RETU – 15).Value = strFilename |
| 39 | strFilename = Dir() |
| 40 | Loop |
| 41 | For i = 2 To retum Step 17 |
| 42 | Csh.Cells(10, i).Select |
| 43 | syasin = Ash.Cells(3, 1) & “\" & Csh.Cells(3, i).Value |
| 44 | Csh.Pictures.Insert syasin |
| 45 | Csh.Pictures.Top = Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Top |
| 46 | Csh.Pictures.Left = Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Left |
| 47 | |
| 48 | Csh.Pictures.Height = Range(Csh.Cells(10, i), Csh.Cells(44, i + 15)).Height |
| 49 | Next i |
| 50 | End Sub |
複数の写真をまとめて貼り付けるマクロはデスクワークで効果的
今回紹介した複数の写真をまとめて貼り付けるマクロはエクセルに写真を貼り付けて資料を作成することが多い！という方に是非使ってもらいたい。いろんなメリットを体感できるはずです。
- キレイな資料になる
- 写真挿入後の編集がやりやすい
- 写真を挿入するだけで書類として使える
今回は仕事で使えるをテーマに様式を作成しました。いろんな種類の提出書類を作成してきた私が考える丁度いいと考える写真の大きさは、A4用紙に3枚の写真が入る大きさ です。
A4用紙に写真が3枚、右側3分の1を写真の名前の表示で使用する様式になっています。
写真の補足説明や注意事項を入力するために「ファイル名表示」の下はわざと空欄を作っています。今回紹介しているマクロではファイル名にファイル形式が表示されます。
ファイル形式（.jpg)を非表示にすることも可能です。
もし、このマクロと同じ処理を手作業で行うとかなり時間がかかりいます。
このように写真をまとめて挿入すると、この後の編集にかなり時間がかかります。
- 大きさを編集
- 表示位置を編集
- 名前を付ける
- 全体を揃える
今回紹介するマクロを使えば、時間のかかる編集作業を一瞬で処理することができ、さらに作業ミスがなくなるというメリットもあります。
ダウンする人
下記の記事では、VBA参考書の選び方とポイントについて詳しく紹介しています。この記事で紹介している「写真を自動で貼り付けるエクセルマクロ」もVBA参考書を使って開発したものです。
仕事の効率アップにつながるマクロを開発してみたい！と考えている方は是非参考書で読んでみて下さい。あなたの考えを表現するためのVBAがきっと見つかると思います。
写真の貼り付けを自動化するマクロを使いたい方へ
写真の貼り付けマクロのダウンロード
この記事でご紹介した「写真の貼付けマクロ」が設定されたエクセルファイルを下記のサイトでダウンロードすることができます。
写真の貼り付けを自動化するマクロを、仕事やプライベートのパソコンで使ってみたい！という方におすすめです。
すでに写真の貼り付けを自動化するマクロが設定されているので、
貼り付けたい写真が保存されているフォルダの場所を指定し実行ボタンを押下するだけで大量の写真を一瞬で貼り付けることが可能です。
写真の貼り付けマクロの作成依頼
マクロが設定されたエクセルをダウンロードするのではなく、仕事やプライベートで使っている様式に写真を貼り付けるマクロを設定することができます。
ガッツポーズの人
仕事で使っている様式に写真を貼り付けたい
マクロが設定されたエクセルをダウンロードしても様式の変更が難しい
写真の貼付け以外に、テキストを転記したり色を変える処理も自動化したい
このように「具体的にこんな作業を自動化したい」というビジョンをお持ちの方は、マメBlogへマクロ開発依頼をご検討ください。
この記事で紹介している「写真の貼り付けを自動化するマクロ」を、お使いのエクセルに組み込む、写真の貼り付け方法を自由に操作する、などのアレンジが可能です。
「写真の貼り付けを自動化するマクロ」を使ってエクセル業務の効率をアップさせたい方は下記の送信フォームから依頼内容を記載して送信してください。
マクロの開発依頼ではなく、質問などの問い合わせもだけでも構いません。お気軽にお問い合わせください。