【AI × Excel VBA】複数の画像ファイルを一括リサイズ 【改訂版 / v1.1.0】

[Pres_ImageResizeLauncher]
└─ RunImageResize : 実行入口
   ├─ [App_ImageResizeRunner]
   │  └─ ExecuteImageResize : 全体制御
   │     ├─ [Inf_ImageFileAccessor]
   │     │  ├─ TryBuildResizeSettings : 設定取得
   │     │  │  ├─ TryReadPositiveLongFromCell : セル読取
   │     │  │  └─ FolderExists : フォルダ確認
   │     │  └─ FindTargetImageFilePaths : 対象列挙
   │     │
   │     ├─ [Util_ImagePathHelper]
   │     │  ├─ IsTargetImageFileName : 拡張子判定
   │     │  └─ GetLowerCaseExtension : 拡張子整形
   │     │
   │     └─ ProcessSingleImageFile : 単一画像処理
   │        ├─ [Inf_ImageFileAccessor]
   │        │  ├─ TryLoadImageSize : サイズ取得
   │        │  ├─ ImageFileExists : 既存確認
   │        │  └─ SaveResizedImageFile : 保存実行
   │        │
   │        ├─ [Dom_ResizeDimensionCalculator]
   │        │  ├─ IsUpscalingRequired : 拡大判定
   │        │  │  └─ GetResizeRatio : 比率算出
   │        │  └─ CalculateResizedDimensions : サイズ計算
   │        │     └─ GetResizeRatio : 比率算出
   │        │
   │        └─ [Util_ImagePathHelper]
   │           └─ BuildResizedFilePath : 保存先生成
   │
   └─ ShowResizeExecutionResult : 結果表示
      └─ BuildResizeCompletionMessage : 文言作成

Public Sub RunImageResize()
    ' Description
    '   ボタン操作から画像リサイズ処理を起動し、
    '   実行結果に応じたメッセージをユーザーへ表示する。
    '
    ' Arguments
    '   (None)
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   RunImageResize
    '     ├─ ExecuteImageResize (App_ImageResizeRunner)
    '     └─ ShowResizeExecutionResult (Pres_ImageResizeLauncher)

    ' リサイズ処理の実行
    '--------------------------------------------------------------------------
    ' 実行結果格納用の構造体を初期化
    Dim execution_result As ResizeExecutionResult

    ' アプリケーション層でリサイズ処理全体を実行
    Call ExecuteImageResize(execution_result)

    ' 実行結果の表示
    '--------------------------------------------------------------------------
    ' 実行結果に応じたメッセージをユーザーへ表示
    Call ShowResizeExecutionResult(execution_result)

End Sub

Private Sub ShowResizeExecutionResult(ByRef execution_result As ResizeExecutionResult)
    ' Description
    '   画像リサイズ処理の実行結果に応じて、
    '   ユーザーへ適切なメッセージを表示する。
    '
    ' Arguments
    '   execution_result : 画像リサイズ処理の実行結果
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   ShowResizeExecutionResult
    '     └─ BuildResizeCompletionMessage (Pres_ImageResizeLauncher)

    ' 異常終了時の表示
    '--------------------------------------------------------------------------
    ' エラーメッセージが返ってきている場合は警告表示して終了
    If Len(Trim$(execution_result.error_message)) > 0 Then
        MsgBox execution_result.error_message, vbExclamation
        Exit Sub
    End If

    ' 対象画像なし時の表示
    '--------------------------------------------------------------------------
    ' 対象画像が 0 件なら正常完了メッセージは出さずに終了
    If execution_result.target_file_count = 0 Then
        MsgBox "フォルダに画像ファイルが見つかりませんでした。処理を中断します。", vbExclamation
        Exit Sub
    End If

    ' 正常終了時の表示
    '--------------------------------------------------------------------------
    ' 実行結果を含む完了メッセージを表示
    MsgBox BuildResizeCompletionMessage(execution_result), vbInformation

End Sub

Private Function BuildResizeCompletionMessage( _
    ByRef execution_result As ResizeExecutionResult _
) As String

    ' Description
    '   実行結果から、完了を伝えるメッセージを組み立てて返す。
    '
    ' Arguments
    '   execution_result : 画像リサイズ処理の実行結果
    '
    ' Returns
    '   String
    '     実行結果を表すメッセージ
    '
    ' Dependency Tree
    '   BuildResizeCompletionMessage
    '     (none)

    ' 完了メッセージの組み立て
    '--------------------------------------------------------------------------
    ' まずは基本となる完了メッセージを設定
    Dim completion_message As String
    completion_message = "リサイズが完了しました。"
    completion_message = completion_message & vbCrLf & vbCrLf

    ' 対象件数と保存件数の追記
    completion_message = completion_message & "対象画像数: " & execution_result.target_file_count & " 件"
    completion_message = completion_message & vbCrLf
    completion_message = completion_message & "保存件数: " & execution_result.resized_file_count & " 件"

    ' 同名ファイルによるスキップが発生した場合は補足
    If execution_result.skipped_existing_count > 0 Then
        completion_message = completion_message & vbCrLf
        completion_message = completion_message & _
            "同名ファイルがすでに存在したため、" & execution_result.skipped_existing_count & " 件をスキップしました。"
    End If

    BuildResizeCompletionMessage = completion_message

End Function

Public Type ResizeSettings
    ' 入力画像格納フォルダパス
    source_folder_path As String

    ' リサイズ後画像の出力先フォルダパス
    output_folder_path As String

    ' リサイズ後の最大幅
    max_width As Long

    ' リサイズ後の最大高さ
    max_height As Long
End Type

Public Type ResizeExecutionResult
    ' 対象画像ファイル数
    target_file_count As Long

    ' 実際に保存できた画像ファイル数
    resized_file_count As Long

    ' 同名ファイルの存在による保存スキップ回数
    skipped_existing_count As Long

    ' 異常終了時のエラーメッセージ
    error_message As String
End Type

Public Sub ExecuteImageResize(ByRef execution_result As ResizeExecutionResult)
    ' Description
    '   画像リサイズ処理のユースケース全体を制御する。
    '   設定取得、対象ファイル列挙、画像ごとのリサイズ保存処理を順に実行する。
    '
    ' Arguments
    '   execution_result : 画像リサイズ処理の実行結果
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   ExecuteImageResize
    '     ├─ TryBuildResizeSettings (Inf_ImageFileAccessor)
    '     ├─ FindTargetImageFilePaths (Inf_ImageFileAccessor)
    '     └─ ProcessSingleImageFile (App_ImageResizeRunner)

    ' 設定と対象ファイルの取得
    '--------------------------------------------------------------------------
    ' 実行時に利用する設定を取得
    Dim resize_settings As ResizeSettings
    If Not TryBuildResizeSettings(resize_settings, execution_result.error_message) Then Exit Sub

    ' 入力フォルダ配下の画像ファイルパス一覧を取得
    Dim source_file_path_coll As Collection
    Set source_file_path_coll = FindTargetImageFilePaths(resize_settings.source_folder_path)
    If source_file_path_coll Is Nothing Then Exit Sub

    ' 対象画像が0件なら結果へ反映
    execution_result.target_file_count = source_file_path_coll.Count
    If execution_result.target_file_count = 0 Then Exit Sub

    ' 画像ごとのリサイズ処理
    '--------------------------------------------------------------------------
    ' コレクションに格納した各画像パスを順に処理
    Dim source_file_path As Variant
    For Each source_file_path In source_file_path_coll
        ' 単一画像のリサイズ保存処理を実行
        Call ProcessSingleImageFile( _
            CStr(source_file_path), _
            resize_settings, _
            execution_result _
        )

        ' 途中で異常が発生した場合は後続処理を中止する
        If Len(Trim$(execution_result.error_message)) > 0 Then Exit Sub
    Next source_file_path

End Sub

Private Sub ProcessSingleImageFile( _
    ByVal source_file_path As String, _
    ByRef resize_settings As ResizeSettings, _
    ByRef execution_result As ResizeExecutionResult _
)
    ' Description
    '   単一画像ファイルに対して、サイズ取得、出力先決定、
    '   リサイズ保存までを実行し、実行結果を更新する。
    '
    ' Arguments
    '   source_file_path  : 入力画像ファイルパス
    '   resize_settings   : リサイズ設定
    '   execution_result  : 画像リサイズ処理の実行結果
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   ProcessSingleImageFile
    '     ├─ TryLoadImageSize (Inf_ImageFileAccessor)
    '     ├─ IsUpscalingRequired (Dom_ResizeDimensionCalculator)
    '     ├─ CalculateResizedDimensions (Dom_ResizeDimensionCalculator)
    '     ├─ BuildResizedFilePath (Util_ImagePathHelper)
    '     ├─ ImageFileExists (Inf_ImageFileAccessor)
    '     └─ SaveResizedImageFile (Inf_ImageFileAccessor)

    ' 元画像サイズの取得
    '--------------------------------------------------------------------------
    ' 入力画像の幅と高さを取得
    Dim source_width As Long
    Dim source_height As Long
    If Not TryLoadImageSize( _
        source_file_path, _
        source_width, _
        source_height, _
        execution_result.error_message _
    ) Then
        Exit Sub
    End If

    ' リサイズ方向の妥当性確認
    '--------------------------------------------------------------------------
    ' 拡大が必要になる画像は対象外として処理を中断
    If IsUpscalingRequired( _
        source_width, _
        source_height, _
        resize_settings.max_width, _
        resize_settings.max_height _
    ) Then
        execution_result.error_message = _
            "指定サイズでは拡大が必要になる画像が含まれているため、処理を中断しました。" & vbCrLf & _
            "対象ファイル: " & source_file_path
        Exit Sub
    End If

    ' リサイズ後サイズの算出
    '--------------------------------------------------------------------------
    ' 最大幅・最大高さに収まるリサイズ後サイズを算出
    Dim resized_width As Long
    Dim resized_height As Long
    Call CalculateResizedDimensions( _
        source_width, _
        source_height, _
        resize_settings.max_width, _
        resize_settings.max_height, _
        resized_width, _
        resized_height _
    )

    ' 出力先決定と保存
    '--------------------------------------------------------------------------
    ' 出力フォルダ配下の保存先パスを組み立てる
    Dim output_file_path As String
    output_file_path = BuildResizedFilePath( _
        source_file_path, _
        resize_settings.output_folder_path _
    )

    ' 同名ファイルがすでに存在する場合は上書きせずにスキップ
    If ImageFileExists(output_file_path) Then
        execution_result.skipped_existing_count = execution_result.skipped_existing_count + 1
        Exit Sub
    End If

    ' 画像保存に失敗した場合はエラー内容を結果へ返す
    If Not SaveResizedImageFile( _
        source_file_path, _
        output_file_path, _
        resized_width, _
        resized_height, _
        execution_result.error_message _
    ) Then
        Exit Sub
    End If

    ' 保存が成功したら結果へ加算
    execution_result.resized_file_count = execution_result.resized_file_count + 1

End Sub

Public Sub CalculateResizedDimensions( _
    ByVal source_width As Long, _
    ByVal source_height As Long, _
    ByVal max_width As Long, _
    ByVal max_height As Long, _
    ByRef resized_width As Long, _
    ByRef resized_height As Long _
)
    ' Description
    '   元画像サイズと最大サイズから、
    '   縦横比を維持したリサイズ後サイズを算出する。
    '   元画像が指定サイズ以内の場合は拡大せず、そのままのサイズを返す。
    '
    ' Arguments
    '   source_width    : 元画像の幅
    '   source_height   : 元画像の高さ
    '   max_width       : リサイズ後の最大幅
    '   max_height      : リサイズ後の最大高さ
    '   resized_width   : リサイズ後の幅
    '   resized_height  : リサイズ後の高さ
    '
    ' Returns
    '   なし
    '
    ' Dependency Tree
    '   CalculateResizedDimensions
    '     └─ GetResizeRatio (Dom_ResizeDimensionCalculator)

    ' リサイズ比率の算出
    '--------------------------------------------------------------------------
    ' 最大幅に収まる比率を取得
    Dim resize_ratio As Double
    resize_ratio = GetResizeRatio(source_width, source_height, max_width, max_height)

    ' リサイズ後サイズの設定
    '--------------------------------------------------------------------------
    ' 算出した比率を元画像サイズへ反映
    resized_width = CLng(source_width * resize_ratio)
    resized_height = CLng(source_height * resize_ratio)

End Sub

Public Function IsUpscalingRequired( _
    ByVal source_width As Long, _
    ByVal source_height As Long, _
    ByVal max_width As Long, _
    ByVal max_height As Long _
) As Boolean
    ' Description
    '   指定サイズへ収めるときに、拡大が必要かどうかを返す。
    '   幅比率と高さ比率の両方が 1 を超える場合は拡大が必要と判定する。
    '
    ' Arguments
    '   source_width   : 元画像の幅
    '   source_height  : 元画像の高さ
    '   max_width      : リサイズ後の最大幅
    '   max_height     : リサイズ後の最大高さ
    '
    ' Returns
    '   Boolean
    '     True  : 拡大が必要
    '     False : 拡大は不要
    '
    ' Dependency Tree
    '   IsUpscalingRequired
    '     └─ GetResizeRatio (Dom_ResizeDimensionCalculator)

    ' リサイズ比率の確認
    '--------------------------------------------------------------------------
    ' 比率が 1 を超える場合は拡大が必要とみなす
    IsUpscalingRequired = (GetResizeRatio(source_width, source_height, max_width, max_height) > 1#)

End Function

Private Function GetResizeRatio( _
    ByVal source_width As Long, _
    ByVal source_height As Long, _
    ByVal max_width As Long, _
    ByVal max_height As Long _
) As Double

    ' Description
    '   元画像サイズを最大サイズへ収めるための比率を返す。
    '   拡大判定ではこのままの比率を返し、呼び出し元で判断を分ける。
    '
    ' Arguments
    '   source_width   : 元画像の幅
    '   source_height  : 元画像の高さ
    '   max_width      : リサイズ後の最大幅
    '   max_height     : リサイズ後の最大高さ
    '
    ' Returns
    '   Double
    '     リサイズ比率
    '
    ' Dependency Tree
    '   GetResizeRatio
    '     (none)

    ' 幅と高さの比率を比較
    '--------------------------------------------------------------------------
    ' 幅方向から求まる比率を算出
    Dim width_ratio As Double
    width_ratio = max_width / source_width

    ' 高さ方向から求まる比率を算出
    Dim height_ratio As Double
    height_ratio = max_height / source_height

    ' 小さい比率を採用して最大幅に収める
    If width_ratio <= height_ratio Then
        GetResizeRatio = width_ratio
    Else
        GetResizeRatio = height_ratio
    End If

End Function

Public Function TryBuildResizeSettings( _
    ByRef resize_settings As ResizeSettings, _
    ByRef error_message As String _
) As Boolean

    ' Description
    '   ブックと設定セルから、画像リサイズ処理で使用する設定値を組み立てる。
    '   必要なフォルダや設定値が不正な場合は、エラーメッセージを返す。
    '
    ' Arguments
    '   resize_settings : 画像リサイズ設定
    '   error_message   : エラーメッセージ
    '
    ' Returns
    '   Boolean
    '     True  : 設定取得成功
    '     False : 設定取得失敗
    '
    ' Dependency Tree
    '   TryBuildResizeSettings
    '     ├─ TryReadPositiveLongFromCell (Inf_ImageFileAccessor)
    '     └─ FolderExists (Inf_ImageFileAccessor)

    ' 固定仕様の取得
    '--------------------------------------------------------------------------
    Const SOURCE_FOLDER_NAME   As String = "A_リサイズ前画像ファイル"
    Const OUTPUT_FOLDER_NAME   As String = "B_リサイズ後の画像ファイル"
    Const SETTING_SHEET_INDEX  As Long = 1
    Const MAX_WIDTH_ROW        As Long = 25
    Const MAX_HEIGHT_ROW       As Long = 26
    Const SETTING_VALUE_COLUMN As Long = 5

    ' 保存場所と対象フォルダの確認
    '--------------------------------------------------------------------------
    ' 未保存ブックでは相対フォルダを組み立てられないため先に弾く
    If Len(Trim$(ThisWorkbook.Path)) = 0 Then
        error_message = "ブックの保存場所が取得できませんでした。保存済みのブックで実行してください。"
        Exit Function
    End If

    ' ブック保存場所配下の入力フォルダパスを設定
    resize_settings.source_folder_path = ThisWorkbook.Path & "\" & SOURCE_FOLDER_NAME

    ' 入力フォルダが存在しない場合は処理を中断
    If Not FolderExists(resize_settings.source_folder_path) Then
        error_message = "入力フォルダが見つかりませんでした。フォルダ名を確認してください。" & vbCrLf & _
            resize_settings.source_folder_path
        Exit Function
    End If

    ' ブック保存場所配下の出力フォルダパスを設定
    resize_settings.output_folder_path = ThisWorkbook.Path & "\" & OUTPUT_FOLDER_NAME

    ' 出力フォルダが存在しない場合は処理を中断
    If Not FolderExists(resize_settings.output_folder_path) Then
        error_message = "出力フォルダが見つかりませんでした。フォルダ名を確認してください。" & vbCrLf & _
            resize_settings.output_folder_path
        Exit Function
    End If

    ' 設定値の取得
    '--------------------------------------------------------------------------
    ' シートから最大幅を読み込む
    If Not TryReadPositiveLongFromCell( _
        ThisWorkbook.Worksheets(SETTING_SHEET_INDEX), _
        MAX_WIDTH_ROW, _
        SETTING_VALUE_COLUMN, _
        "最大幅", _
        resize_settings.max_width, _
        error_message _
    ) Then
        Exit Function
    End If

    ' シートから最大高さを読み込む
    If Not TryReadPositiveLongFromCell( _
        ThisWorkbook.Worksheets(SETTING_SHEET_INDEX), _
        MAX_HEIGHT_ROW, _
        SETTING_VALUE_COLUMN, _
        "最大高さ", _
        resize_settings.max_height, _
        error_message _
    ) Then
        Exit Function
    End If

    TryBuildResizeSettings = True

End Function

Public Function FindTargetImageFilePaths( _
    ByVal source_folder_path As String _
) As Collection

    ' Description
    '   対象フォルダ配下の画像ファイルパス一覧を集めて返す。
    '
    ' Arguments
    '   source_folder_path : 対象フォルダパス
    '
    ' Returns
    '   Collection
    '     対象画像ファイルパス一覧
    '
    ' Dependency Tree
    '   FindTargetImageFilePaths
    '     └─ IsTargetImageFileName (Util_ImagePathHelper)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' フォルダ内ファイルの列挙
    '--------------------------------------------------------------------------
    ' ファイル列挙に使用する FSO を生成
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    ' 対象フォルダオブジェクトを取得
    Dim source_folder As Folder
    Set source_folder = fso.GetFolder(source_folder_path)

    ' 対象画像ファイルパスの格納用コレクションを初期化
    Dim image_file_path_coll As Collection
    Set image_file_path_coll = New Collection

    ' フォルダ内の各ファイルを順番に確認
    Dim target_file As File
    For Each target_file In source_folder.Files
        ' 対象拡張子の画像だけを集約
        If IsTargetImageFileName(target_file.Name) Then
            image_file_path_coll.Add target_file.Path
        End If
    Next target_file

    Set FindTargetImageFilePaths = image_file_path_coll

End Function

Public Function TryLoadImageSize( _
    ByVal image_file_path As String, _
    ByRef image_width As Long, _
    ByRef image_height As Long, _
    ByRef error_message As String _
) As Boolean

    ' Description
    '   画像ファイルを読み込み、幅と高さを取得する。
    '
    ' Arguments
    '   image_file_path : 画像ファイルパス
    '   image_width     : 画像幅
    '   image_height    : 画像高さ
    '   error_message   : エラーメッセージ
    '
    ' Returns
    '   Boolean
    '     True  : 読み込み成功
    '     False : 読み込み失敗
    '
    ' Dependency Tree
    '   TryLoadImageSize
    '     (none)
    '
    ' References
    '   Microsoft Windows Image Acquisition Library v2.0

    On Error GoTo LoadError

    ' 画像サイズの取得
    '--------------------------------------------------------------------------
    ' WIA の ImageFile で入力画像を読み込む
    Dim image_object As ImageFile
    Set image_object = New ImageFile
    image_object.LoadFile image_file_path

    ' 読み込んだ画像の幅と高さを返却値へ設定
    image_width = image_object.Width
    image_height = image_object.Height

    TryLoadImageSize = True
    Exit Function

LoadError:
    error_message = "画像サイズの取得に失敗しました。" & vbCrLf & image_file_path
End Function

Public Function SaveResizedImageFile( _
    ByVal source_file_path As String, _
    ByVal output_file_path As String, _
    ByVal resized_width As Long, _
    ByVal resized_height As Long, _
    ByRef error_message As String _
) As Boolean

    ' Description
    '   画像ファイルを読み込み、指定サイズへリサイズして保存する。
    '
    ' Arguments
    '   source_file_path : 入力画像ファイルパス
    '   output_file_path : 出力画像ファイルパス
    '   resized_width    : リサイズ後の幅
    '   resized_height   : リサイズ後の高さ
    '   error_message    : エラーメッセージ
    '
    ' Returns
    '   Boolean
    '     True  : 保存成功
    '     False : 保存失敗
    '
    ' Dependency Tree
    '   SaveResizedImageFile
    '     (none)
    '
    ' References
    '   Microsoft Windows Image Acquisition Library v2.0

    On Error GoTo SaveError

    ' 画像の読み込み
    '--------------------------------------------------------------------------
    ' 入力画像を WIA で読み込む
    Dim image_object As ImageFile
    Set image_object = New ImageFile
    image_object.LoadFile source_file_path

    ' リサイズ処理の適用
    '--------------------------------------------------------------------------
    ' Scale フィルタを追加して最大幅・最大高さを設定
    Dim image_processor As ImageProcess
    Set image_processor = New ImageProcess
    image_processor.Filters.Add image_processor.FilterInfos("Scale").FilterID
    image_processor.Filters(1).Properties("MaximumWidth").Value = resized_width
    image_processor.Filters(1).Properties("MaximumHeight").Value = resized_height

    ' フィルタ適用後の画像へ差し替える
    Set image_object = image_processor.Apply(image_object)

    ' リサイズ後ファイルの保存
    '--------------------------------------------------------------------------
    ' 出力先パスへ画像を保存
    image_object.SaveFile output_file_path

    SaveResizedImageFile = True
    Exit Function

SaveError:
    error_message = "画像ファイルの保存に失敗しました。" & vbCrLf & output_file_path
End Function

Public Function ImageFileExists(ByVal file_path As String) As Boolean
    ' Description
    '   指定ファイルが存在するかどうかを返す。
    '
    ' Arguments
    '   file_path : 判定対象ファイルパス
    '
    ' Returns
    '   Boolean
    '     True  : 存在する
    '     False : 存在しない
    '
    ' Dependency Tree
    '   ImageFileExists
    '     (none)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' ファイル存在判定
    '--------------------------------------------------------------------------
    ' FileSystemObject でファイル有無を判定
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    ImageFileExists = fso.FileExists(file_path)

End Function

Public Function FolderExists(ByVal folder_path As String) As Boolean
    ' Description
    '   指定フォルダが存在するかどうかを返す。
    '
    ' Arguments
    '   folder_path : 判定対象フォルダパス
    '
    ' Returns
    '   Boolean
    '     True  : 存在する
    '     False : 存在しない
    '
    ' Dependency Tree
    '   FolderExists
    '     (none)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' フォルダ存在判定
    '--------------------------------------------------------------------------
    ' FileSystemObject でフォルダ有無を判定
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    FolderExists = fso.FolderExists(folder_path)

End Function

Private Function TryReadPositiveLongFromCell( _
    ByVal target_ws As Worksheet, _
    ByVal target_row As Long, _
    ByVal target_col As Long, _
    ByVal item_name As String, _
    ByRef output_value As Long, _
    ByRef error_message As String _
) As Boolean

    ' Description
    '   指定セルから正の整数値を読み込み、設定値として返す。
    '
    ' Arguments
    '   target_ws      : 対象シート
    '   target_row     : 対象行
    '   target_col     : 対象列
    '   item_name      : 項目名
    '   output_value   : 読み込み結果
    '   error_message  : エラーメッセージ
    '
    ' Returns
    '   Boolean
    '     True  : 読み込み成功
    '     False : 読み込み失敗
    '
    ' Dependency Tree
    '   TryReadPositiveLongFromCell
    '     (none)

    ' セル値の妥当性確認
    '--------------------------------------------------------------------------
    ' 設定シートから対象セルの値を取得
    Dim cell_value As Variant
    cell_value = target_ws.Cells(target_row, target_col).Value

    ' 数値でない場合は設定不正として扱う
    If Not IsNumeric(cell_value) Then
        error_message = item_name & " の設定値が数値ではありません。シートの設定値を確認してください。"
        Exit Function
    End If

    ' 正の整数として扱える値なら Long へ変換
    output_value = CLng(cell_value)

    ' 0 以下の値は設定不正として扱う
    If output_value <= 0 Then
        error_message = item_name & " の設定値は 1 以上で入力してください。"
        Exit Function
    End If

    TryReadPositiveLongFromCell = True

End Function

Public Function IsTargetImageFileName(ByVal file_name As String) As Boolean
    ' Description
    '   指定ファイルが画像リサイズ対象の拡張子かどうかを返す。
    '
    ' Arguments
    '   file_name : 判定対象ファイル名
    '
    ' Returns
    '   Boolean
    '     True  : 対象画像ファイル
    '     False : 対象外ファイル
    '
    ' Dependency Tree
    '   IsTargetImageFileName
    '     └─ GetLowerCaseExtension (Util_ImagePathHelper)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' 対象拡張子の判定
    '--------------------------------------------------------------------------
    ' 比較前に拡張子を小文字化する関数を適用
    Dim extension_name As String
    extension_name = GetLowerCaseExtension(file_name)

    ' 対象拡張子なら True を返す
    Select Case extension_name
        Case "png", "jpg", "jpeg"
            IsTargetImageFileName = True
    End Select

End Function

Public Function BuildResizedFilePath( _
    ByVal source_file_path As String, _
    ByVal output_folder_path As String _
) As String
    ' Description
    '   入力画像ファイルパスと出力フォルダパスから、
    '   リサイズ後の出力ファイルパスを組み立てる。
    '
    ' Arguments
    '   source_file_path   : 入力画像ファイルパス
    '   output_folder_path : 出力フォルダパス
    '
    ' Returns
    '   String
    '     リサイズ後の出力ファイルパス
    '
    ' Dependency Tree
    '   BuildResizedFilePath
    '     (none)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' 出力ファイルパスの組み立て
    '--------------------------------------------------------------------------
    ' パス操作に使用する FSO を生成
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    ' 元画像の拡張子なしファイル名を取得
    Dim base_name As String
    base_name = fso.GetBaseName(source_file_path)

    ' 出力時に利用する拡張子を取得
    Dim extension_name As String
    extension_name = fso.GetExtensionName(source_file_path)

    ' 出力フォルダ配下の保存先フルパスのファイル名を返す
    BuildResizedFilePath = output_folder_path & "\" & base_name & "_リサイズ済み." & extension_name

End Function

Private Function GetLowerCaseExtension(ByVal file_name As String) As String
    ' Description
    '   ファイル名から拡張子を小文字で返す。
    '
    ' Arguments
    '   file_name : 対象ファイル名
    '
    ' Returns
    '   String
    '     小文字化された拡張子
    '
    ' Dependency Tree
    '   GetLowerCaseExtension
    '     (none)
    '
    ' References
    '   Microsoft Scripting Runtime

    ' 拡張子の抽出
    '--------------------------------------------------------------------------
    ' 拡張子取得に使用する FSO を生成
    Dim fso As Scripting.FileSystemObject
    Set fso = New Scripting.FileSystemObject

    ' 比較しやすいように小文字・前後空白除去で返す
    GetLowerCaseExtension = LCase$(Trim$(fso.GetExtensionName(file_name)))

End Function