Home » エクセルマクロ・Excel VBAの使い方 » マクロのサンプル » 縦横比が一定以下のPNGファイルの一覧を作成するExcelマクロ

縦横比が一定以下のPNGファイルの一覧を作成するExcelマクロ

動作検証バージョン：Windows 11 Home + 64bit Excel バージョン 2501（ビルド18429.20132クイック実行）

複数のPNGファイルの中から、アスペクト比（縦横比）がある値以下のものを調べる必要がありました。

そのためのマクロをExcel VBAで作成したので、ご紹介しておきます。

［スポンサードリンク］

縦横比が一定以下のPNGファイルの一覧を作成するサンプルマクロ

以下のマクロを実行すると、Cドライブtempフォルダー内にあるPNGファイルの中で、長辺÷短辺の値が、1.41以下のものの一覧が新規シートに作成されます。

Sub 縦横比が一定以下の画像名などを新規シートに出力する()

　Const FOL_PATH = "C:\temp\"
　Const IMG_TYPE = "PNG"
　Const RATIO_OK = 1.41 ' A4サイズ（297÷210）のアスペクト比
　
　Dim f_name As String
　f_name = Dir(FOL_PATH & "*." & IMG_TYPE)
　If f_name = "" Then
　　MsgBox FOL_PATH & " フォルダーに " & vbCrLf & IMG_TYPE & " ファイルが見つからないため終了します。"
　　Exit Sub
　End If
　
　Sheets.Add Before:=Sheets(1)
　Cells(1, "A").Value = "ファイル名"
　Cells(1, "B").Value = "高さ"
　Cells(1, "C").Value = "幅"
　Cells(1, "D").Value = "縦横比"
　
　Dim ratio As Double
　Dim i As Long: i = 2
　With CreateObject("WIA.ImageFile")
　　Do Until f_name = ""
　　　.LoadFile FOL_PATH & f_name
　　　ratio = WorksheetFunction.Max(.Height / .Width, .Width / .Height)
　　　If ratio <= RATIO_OK Then
　　　　Cells(i, "A").Value = f_name
　　　　Cells(i, "B").Value = .Height
　　　　Cells(i, "C").Value = .Width
　　　　i = i + 1
　　　End If
　　　f_name = Dir
　　Loop
　End With

　Range("D2", Cells(i - 1, "D")).Formula = "=MAX(B2/C2, C2/B2)"
　Range("A1").CurrentRegion.Columns.AutoFit

End Sub

サンプルマクロで行っている処理

基本的な構造は、既にご紹介しているWIA.ImageFileオブジェクトを使って画像のサイズを一覧にするマクロと同じです。

この処理に、縦横比を計算して、定数RATIO_OKに指定した値以下だった場合にのみ、ファイル名・高さ・幅を出力して、

　Dim ratio As Double
　Dim i As Long: i = 2
　With CreateObject("WIA.ImageFile")
　　Do Until f_name = ""
　　　.LoadFile FOL_PATH & f_name
　　　ratio = WorksheetFunction.Max(.Height / .Width, .Width / .Height)
　　　If ratio <= RATIO_OK Then
　　　　Cells(i, "A").Value = f_name
　　　　Cells(i, "B").Value = .Height
　　　　Cells(i, "C").Value = .Width
　　　　i = i + 1
　　　End If

ファイル名・高さ・幅の出力が終わってから、D2セル以下に縦横比を計算する数式を入力する処理を追加しています。

　　Loop
　End With

　Range("D2", Cells(i - 1, "D")).Formula = "=MAX(B2/C2, C2/B2)"
　Range("A1").CurrentRegion.Columns.AutoFit

End Sub

［スポンサードリンク］

Home » エクセルマクロ・Excel VBAの使い方 » マクロのサンプル » 縦横比が一定以下のPNGファイルの一覧を作成するExcelマクロ

『インストラクターのネタ帳』では、2003年10月からMicrosoft Officeの使い方などを紹介し続けています。
Excel VBAの経験がある方を対象に、Word VBAの基本をキンドル本としてまとめました↓↓ Excel VBAユーザーの方を対象として、Wordの表をVBAで操作する基礎をまとめました↓↓ グラフを操作するExcel VBAの基本を解説したキンドル本も出しました↓↓ 図形を操作するExcel VBAの基本を解説したキンドル本を書きました↓↓ 『インストラクターのネタ帳』を運営する伊藤潔人が、初めて書かせていただいた書籍です↓↓ PowerPoint VBA本は、実はオブジェクトブラウザーの使い方を徹底的に解説した本です↓↓ Pythonの外部ライブラリOpenPyXL（オープンパイエクセル）の入門書を、Excel VBAユーザーに向けに書きました↓↓ 数式を使った条件付き書式設定が苦手な方に向けたKindle本を書きました↓↓ Pythonの文字列フォーマットの基本をキンドル本としてまとめました↓↓ 小数とPythonのdecimalモジュールの基本をキンドル本としてまとめました↓↓ 日経BP社から出版された、Excel VBAユーザー向けのPython超入門書です↓↓ 日経BP社から出版されたExcel VBAユーザー向けのPython超入門書の、元になったキンドル本です↓↓


「マクロのサンプル」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.