複数のファルダに保存された写真データを一瞬でエクセルに貼り付けるVBA

いろんなフォルダに保存された写真データを効率よくエクセルに貼り付けたい！

こんな要望に応えるVBAを開発したのでご紹介します。

この記事では、複数のフォルダから写真データをエクセルに貼り付けるVBAについて、使い方や使われているVBAの解説はもちろん、記事の最後ではVBAが設定されたエクセルファイルをダウンロードすることができます。
エクセルに写真を貼り付ける作業が多い方におすすめの内容になっています。

複数のフォルダから写真データをエクセルに貼り付けるVBAとは

このVBAは、いろんな場所に保存されたフォルダから必要な分の写真データをエクセルに貼り付けたい！というときに役立ちます。

VBAの概要として、エクセルに貼り付けたい写真が保存されているフォルダを指定し、VBAで写真データの情報をリスト化します。次にリスト化した写真データに番号を付けて貼り付ける順番を決めます。最後に写真を貼り付けるVBAを実行すると、一瞬で写真を貼り付けることができます。
VBAを実行したときに写真データの大きさや貼り付け場所は自動的に調整する設定になっているので、めんどうな編集作業は一切必要ありません。

複数のフォルダから写真データをエクセルに貼り付けるVBAは次のような人におすすめです。

・写真データがいろんなフォルダに保存されていて探すのに時間がかかる
・エクセルに写真を貼り付ける作業が多い
・貼り付けた写真の編集作業の手間をできるだけ省きたい

エクセルに写真を貼り付ける作業に少しでもストレスを感じている方は是非この記事で紹介している複数のフォルダから写真データをエクセルに貼り付けるVBAの導入を検討してみてください。

複数のフォルダから写真データをエクセルに貼り付けるVBAの使い方

1.写真が保存されているフォルダを指定

貼り付ける写真が保存されているフォルダの場所を｢設定Sheet｣のA列に記入します。フォルダはいくつでも指定することができるので、貼り付ける写真がいろんなあ場所に保存されていても問題ありません。

2.フォルダに保存されている写真データの情報を取得するVBAを実行

写真データの情報を取得するVBAを実行すると、写真データの名前、保存場所がC列とD列に自動で表示されます。

大量の写真データの情報を一瞬で一覧にすることができるのでとても便利なVBAです。

3.貼り付ける写真の順番を決める

貼り付ける写真データの順番を一覧表に記入します。

入力した数字(整数)で写真が貼り付けられる位置が決まります。そのため｢この場所には写真を貼り付けたくない！｣という場所の番号を飛ばして入力すれば間隔をあけて写真を貼り付けることができます。

上手で④の場所に写真を貼り付けたくない場合、「貼り付け順番」に１，２，３，５，と番号をつけてください。

4.写真を貼り付けるVBAを実行

写真Sheetに移動するとユーザーフォームで写真を貼り付けVBAのボタンが表示されるので、クリックしてVBAを実行する。

｢設定Sheet｣の張り付け順番で４を記入していないので4番目の場所には写真が貼り付けられていないことがわかります。
「この場所には写真ではなくテキストを入力したい！」というようなときに便利です。

使われているVBAの解説

複数のファルダに保存された写真データを一瞬でエクセルに貼り付けるVBAには大きく分けて2つのVBAが設定されています。
１つ目は、写真データの情報から写真を貼り付けるVBA。2つ目は、指定するフォルダから写真データを取得するVBAです。それぞれのVBA単体でもかなり仕事で使えるVBAなのですが、2つを組み合わせることでより効果的なVBAになります。

写真データの情報から写真を貼り付けるVBAについて解説していきます。

1.写真データの情報から写真を貼り付けるVBA

Sub 写真挿入()
   Dim Ash As Worksheet
   Set Ash = Sheets("設定")
   Dim Bsh As Worksheet
   Set Bsh = Sheets("写真")

   Const cnsTitle = "ファイル名一覧取得"
   Const cnsDIR = "\*.*"
   Dim xlAPP As Application
   Dim strPath As String
   Dim strFilename As String
   Dim GYO As Long
   Dim zukei As Shape
   Dim myFileName  As String
   Dim syasin As String
   Dim Path As String
   rm = Bsh.Cells(Rows.Count, 25).End(xlUp).Row
   
   For Each sa In Bsh.Shapes
   On Error Resume Next
   If sa.TopLeftCell.Address >= Bsh.Cells(1, 1).Address Then
   sa.Delete
   End If
   If Err <> 0 Then
   Err.Clear
   End If
   Next
   
   Set xlAPP = Application
   GYO = Ash.Cells(Rows.Count, 3).End(xlUp).Row
   Ash.Range(Ash.Cells(2, 2), Ash.Cells(GYO, 4)).Sort Key1:=Ash.Cells(2, 2), Order1:=xlAscending, Header:=xlYes
   gyo1 = Ash.Cells(Rows.Count, 2).End(xlUp).Row
   For i = 3 To gyo1
   Dim Num As Long
   Num = Ash.Cells(i, 2).Value
   If Num Mod 2 = 0 Then
   Bsh.Cells((Num * 0.5 * 21) + 2, 21).Select
   syasin = Ash.Cells(i, 4) & "\" & Ash.Cells(i, 3)
   Bsh.Pictures.Insert syasin
   Bsh.Pictures.Height = Range(Bsh.Cells((Num * 0.5 * 21) + 1, 21), Bsh.Cells((Num * 0.5 * 21) + 1 + 13, 36)).Height
   Else
   Bsh.Cells(((Num + 1) * 0.5 * 21) + 2, 2).Select
   syasin = Ash.Cells(i, 4) & "\" & Ash.Cells(i, 3)
   Bsh.Pictures.Insert syasin
   Bsh.Pictures.Height = Range(Bsh.Cells(((Num + 1) * 0.5 * 21) + 1, 2), Bsh.Cells(((Num + 1) * 0.5 * 21) + 1 + 13, 17)).Height
   End If
   Next i

   PeNu = Application.WorksheetFunction.RoundDown((Num + 1) / 6, 0)
   Bsh.PageSetup.PrintArea = Bsh.Range(Bsh.Cells(1, 1), Bsh.Cells((63 * PeNu) + 63, 37)).Address
End Sub

上記のプログラムは、複数のファルダに保存された写真データを一瞬でエクセルに貼り付けるVBAに使われているものです。自分で写真を貼り付けるVBAを作ってみたい！という方はコピペして使ってみてください。

貼り付ける順番の奇数は左の列に貼り付け、偶数は右の列に貼り付けをするというプログラムにしているので、長いプログラムに感じるかと思います。難しいVBAはほとんど使われていないので、順番に読み解いてみてください。

写真を貼り付けるVBAのメインは、
　syasin = Ash.Cells(i, 4) & "\" & Ash.Cells(i, 3)
　Bsh.Pictures.Insert syasin
この2行のプログラムです。
ほかの部分は、写真の大きさを調整したり、貼り付ける順番を決定するためのものです。

2.指定するフォルダから写真データを取得するVBA

Sub データ名取得()
   Dim Ash As Worksheet
   Set Ash = Sheets("設定")
   Dim Bsh As Worksheet
   Set Bsh = Sheets("写真")

   gyo1 = Ash.Cells(Rows.Count, 1).End(xlUp).Row
  
   For i = 3 To gyo1
   Dim FP As String
   FP = Ash.Cells(i, 1)
   FoName = Dir(FP & "\*.jpg")
   Do Until FoName = ""
   GYO2 = Ash.Cells(Rows.Count, 3).End(xlUp).Row
   Ash.Cells(GYO2 + 1, 3) = FoName
   Ash.Cells(GYO2 + 1, 4) = FP
   FoName = Dir
   Loop
  
   Next i
End Sub

上記のプログラムは、指定するフォルダから写真データを取得するVBAに使われているものです。
今回は写真を貼り付けるVBAで使っていますが、ファルダ内のデータを整理整頓する作業やファルダ内のデータを把握したいときにも使えるVBAです。

FoName = Dir(FP & "\*.jpg") のプログラムで写真データを変数に入れています。この変数を使って、データの名前や保存場所といった情報を一覧表にしています。

上記のプログラムはコピペして使えるので、気になる方は是非使ってみてください。シート名が｢設定｣、｢写真｣に設定されているので変更するのを忘れないよう注意してください。

複数のフォルダから写真データをエクセルに貼り付けるVBAのダウンロード

複数のファルダに保存された写真データを一瞬でエクセルに貼り付けるVBAをダウンロードしてお使いいただけます。
エクセルに写真を貼り付ける作業が多い！という方は是非使ってみてください。ダウンロードしたけど使い方がわからない、こんな機能を追加してみたい！という質問・要望をお受けしています。お気軽にお問合せください。