トップ > 汎用コード > フォルダ内の画像ファイル情報を一括取得

画像ファイル情報を一括取得

フォルダ内の指定タイプの画像ファイル情報を一括で取得するマクロです。
取得する情報は「ファイル名」「幅(width)」「高さ(height)」「サイズ(byte)」で、取得できる画像タイプは「bmp」「jpg」「png」「gif」の4種類です。

取得した情報は、新規ブックに書き込まれます。


書籍紹介本を執筆しました

Excelを学びのツールに
「Excelで画像編集 ~編集機能を使い倒す!!~」(Kindle版)
Excelは表計算アプリケーションですが、画像や図形の優れた編集機能を備えています。
本書では、それらの機能や操作に焦点をあてた解説をし、あわせて編集の具体例とその方法を紹介します!!


サンプルコード

コードの貼り付け場所

'+++ 宣言セクション +++
Private myWB      As Workbook
Private varImgTyp As Variant

Sub Image_information_acquisition() ' varImgTyp = Array(".bmp", ".jpg", ".png", ".gif") '画像タイプ Dim strDirPath As String 'フォルダの選択 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then strDirPath = .SelectedItems(1) End With If Len(strDirPath) = 0 Then Exit Sub 'フォルダの存在確認 If Dir(strDirPath, vbDirectory) = "" Then Exit Sub 'フォルダ内画像検索 Call Search_Images(strDirPath) End Sub
Private Sub Search_Images(ByVal strPath As String) 'フォルダ内画像検索 strPath:対象フォルダ Dim strTarget As String '対象画像名 Dim lngCount As Long '対象画像数 Dim i As Long 'カウンタ With Application .ScreenUpdating = False '画面更新停止 .DisplayAlerts = False '確認メッセージ非表示 strPath = strPath & .PathSeparator 'フォルダパスにフォルダ区切り文字追加 Set myWB = Workbooks.Add '書き込み用ブック追加 With myWB.Worksheets(1) .Range("A1:B1") = Array("フォルダパス", strPath) .Range("A2:E2") = Array("連番", "画像名", "幅", "高さ", "バイト") End With On Error Resume Next For i = LBound(varImgTyp) To UBound(varImgTyp) strTarget = Dir(strPath & "*" & varImgTyp(i)) 'フォルダ内の画像を検索 Do Until strTarget = "" '画像ファイルがなければループから抜ける lngCount = lngCount + 1 Call Get_Data(strPath, strTarget, lngCount) '画像情報取得 strTarget = Dir() '次の画像ファイルを検索 Loop Next On Error GoTo 0 strTarget = Dir("") If 0 = lngCount Then myWB.Close False MsgBox "画像ファイルが見つかりません", vbInformation Else myWB.Worksheets(1).Columns("A:E").AutoFit End If Set myWB = Nothing .DisplayAlerts = True .ScreenUpdating = True End With End Sub
Private Sub Get_Data(dirPath As String, imgName As String, imgNum As Long) '画像情報取得 Dim mySP As Shape '追加シェープ Dim w As Long '幅 Dim h As Long '高さ Dim b As String 'バイト Set mySP = ActiveSheet.Shapes.AddPicture(dirPath & imgName, False, True, 0, 0, 0, 0) With mySP .LockAspectRatio = msoTrue .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue w = CLng(.Width * 4 / 3) h = CLng(.Height * 4 / 3) .Delete End With b = Format(FileLen(dirPath & imgName), "#,###") myWB.Worksheets(1).Cells(2 + imgNum, "A").Resize(1, 5) = Array(imgNum, imgName, w, h, b) End Sub

ページトップへ戻る

Excel 汎用コード



Word 汎用コード

Copyright(C) 2009- 坂江 保 All Rights Reserved.