VBAで画像を取り込む高速で画像自体を取得しエクセルに貼り付ける

より簡単かつ高速にエクセルに画像を取得出来るコードを紹介

ある依頼をもとにエクセルで画像を扱う為のコードを用意しました。

EnjyoExcel

今回の記事では数秒の内にフォルダ内から画像（写真）を集めてきますよ。

前回記事

あるフォルダの中から画像を持ってくる為のコードを書いてみました。

関連記事VBAで画像を取り込む　フォルダを周回必要な画像をエクセルに貼付

VBAで画像を取り込むフォルダを周回必要な画像をエクセルに貼り付け

複数フォルダ内の画像をキーワードを元にエクセルに貼り付ける方法を紹介　「一定条件のもとフォルダから画像を取り出しエクセルに貼り付けるマクロを作りたい」という依頼に対して作業をしてみました。

www.slt-pgming-21.net

2023.12.07

きっちり改善させました。

この本で勉強しました

CreateObject関数の考え方、使い方が分かる様になります。

私が選んだ書籍の他にも良い本は沢山あります。AmazonのExcelVBA関連の書籍から高評価な書籍を選んでおきました。

ExcelVBA ★4以上のおすすめ書籍はこちら

関連記事

サブルーチンが分かるVBA｜コードが長いプロシージャを短く切り分ける｜マクロを部品化する

改善する為にコードを書き直しました

やってみると数分でさらに良さそうなコードを発見しました。

ワークシート

コード

Sub 案件1_改良_実行()
'1_変数の宣言
Dim base_path As String 'ファイルパスを格納　セルA3の値に￥をつけた
Dim file_name As String  'ファイル名を格納
Dim file_path As String  '上2つの変数をセットにしたもの
Dim i As Long: i = 2 ' 貼付け位置を管理する変数
Dim FSO As Object ' ファイルシステムオブジェクト　フォルダを扱う為の変数
Dim s_fd As Object  '現状掴んでるフォルダを格納する変数
Dim rng As Range '貼り付けるセルを決める為の変数
'***********************************************
'2_画面更新をコントロール（少しでも作業を減らして速度を上げる為）
Application.ScreenUpdating = False
'***********************************************
    '3_フォルダ周回用のループを作成
    'ファイルシステムオブジェクトはオブジェクトなのでSetが必要
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'セルA3に書いてあるパスに存在するフォルダの中に居るフォルダを順番に選択
    For Each s_fd In FSO.GetFolder(Cells(3, 1)).subfolders
    
      'file_pathを作る為の準備
        base_path = s_fd & "\"
        file_name = Dir(base_path, vbNormal)
        file_path = base_path & file_name
        '4_ファイル名のキーワードを確認
        '変数file_nameが無くなるまでループします
        Do Until file_name = ""
            '変数file_nameの中に　_get　が居るか？
            If file_name Like "*_get*" Then
           
　　　　　　　 '5_画像を貼りつけるセルを変数rngにセット
              Set rng = Cells(i + 3, 1)
               
               '6_画像を取得する
               'AddPictureメソッドを使う
               '1回引数を指定しないといけない
               'LeftTopはセル起点、widthHeightはゼロで仮置き
              With rng.Worksheet.Shapes.AddPicture(fileName:=file_path, _
                                                 LinkToFile:=False, _
                                                 SaveWithDocument:=True, _
                                                 Left:=rng.Left, _
                                                 Top:=rng.Top, _
                                                 Width:=0, _
                                                 Height:=0)
                                                                                        
                                        
                    'Shapeプロパティへの処理
                    .LockAspectRatio = True '縦横比固定
                    .Placement = xlMoveAndSize '移動&サイズ変更

                    '縦を元のサイズを起点に100% = 元の画像と同じサイズ
                    .ScaleHeight 1, msoTrue 
                    '横を元のサイズを起点に100% = 元の画像と同じサイズ
                    .ScaleWidth 1, msoTrue
                
                    '7_画像がセルの中心に配置される様に位置と大きさを調整
                    '画像のサイズがセルの「幅-2」より大きかったら・・・
                    If .Width > rng.Width - 2 Then  

                        '画像の幅はセル「幅-2」に変更する
                        .Width = rng.Width - 2  
                    End If
                    '画像のサイズがセルの「高さ-2」より大きかったら・・・ 
                    If .Height > rng.Height - 2 Then 

                        '画像の幅はセル「高さ-2」に変更する
                        .Height = rng.Height - 2  
                    End If
                
                    '画像をセル高さ方向の中心にセット
                    .Top = .Top + ((rng.Height - .Height) / 2) 

                    '画像をセル幅方向の中心にセット
                    .Left = .Left + ((rng.Width - .Width) / 2)  
                        
                End With
    
                i = i + 1
            
            End If
            '8_次の画像を確認する為の処理
            'Dir関数でフォルダ内に居る次のファイルを掴む
            'ファイル名を変数file_nameにセット
            file_name = Dir()
            '変数file_pathに次のファイル名をセットする
            file_path = base_path & file_name
            
        'Doまで戻る
        Loop
    Next s_fd
'***********************************************
'2_画面更新を止める　を解除
Application.ScreenUpdating = True
'***********************************************
'9_作業終了の報告
MsgBox "処理が完了しました", , "作業完了"
End Sub   

削除ボタンは前回記事を参考にしてください。

コードの解説

コードの構成を用意しました。実際のコード内のコメントにふった番号と合わせてご覧ください。

キーになるコード

先程もお伝えしましたが　AddPicture（引数）　です。AddPictureはメソッドです。

パラメータのLinkToFileとSaveWithDocument

アウトプット

コードを書き直す必要は無いです。これならコードが書けない人でも画像の大きさを変えられます。

前回記事からの改善点

気になっている事は全て改善されました。

テスト環境で450枚の画像を使った時は2秒以下。900枚だと約3秒です。

環境を変えてTRYしてみる

さらに出来る事を増やしました

レベルUP【VBA_再帰】複数フォルダ内を検索拡張子を決めて画像を取り出す

【VBA_再帰】複数フォルダ内を検索拡張子を決めて画像を取り出す

1つ前の記事で再帰の基本構造を解説しました。次は応用編です。階層の異なるフォルダ群を検索し特定の拡張子を持った画像データを取り出すというコードを紹介します。再帰を使う事でフォルダ群の隅々まで画像を検索する事ができます。

www.slt-pgming-21.net

2024.01.23

初心者向け【ExcelVBA】再帰呼び出し（再帰処理）は3分の動画で理解できる

まとめ

依頼者様にはデータを納品しました。

参考：関連記事

本シリーズはこちらの記事とも連携しています。

マクロ勉強の道筋マクロは何から勉強するのか｜学習をサポートするためのロードマップを作成

参考：オンライン講座の紹介

おすすめ記事マクロを家で勉強する低価格でイチから教えてもらえるコンテンツを紹介

2023年|VBAを教えてほしい|初心者向け講座|ポイントはエラー対策とVBEの解説

ExcelVBA（マクロ）を勉強出来るスクールの体験レポートです。VBEに関する説明が丁寧だった事とエラーに対する説明が手厚かったのはGoodPointです。この2つのポイントを含めて5点のGoodPointを紹介しています。

www.slt-pgming-21.net

2024.03.08

こちらでVBA勉強出来ます

EnjoyExcel