画像ファイルのフォーマット変換

2024.11.04

画像ファイルを別の画像フォーマット(PNG, Bitmap, Gif, Jpeg, tiff)に変換します。
画像変換時にはファイルの上書きができないので、一度ファイル別名で保存してから、元ファイルを削除し、ファイル名を変更します。

【サンプルプログラム】

Sub Sample()

    ' 画像のフォーマットを変換
    If ConvertImageFormat("C:\ExcelVBA\FileTest\img.png", "C:\ExcelVBA\FileTest\img.jpg", "JPG") = True Then
        MsgBox "画像ファイルの変換が成功しました", vbInformation, "画像ファイルのフォーマット変換"
    Else
        MsgBox "画像ファイルの変換が失敗しました", vbExclamation, "画像ファイルのフォーマット変換"
    End If
    
End Sub

【関数化】

' ------------------------------------------------------------
' 説明：画像のフォーマットを変換
' 引数：1:変換元のファイル名
'       2:変換後のファイル名（拡張子は無視されます）
'       3:変換する画像フォーマット(補足参照)
' 戻値：変換に成功した場合:True
'       変換に失敗した場合:False
' 補足：変換できる画像フォーマットは以下の通り
'       PNGフォーマット (引数3 = png)
'       BMPフォーマット (引数3 = bmp)
'       GIFフォーマット (引数3 = gif)
'       JPEGフォーマット (引数3 = jpg)
'       TIFFフォーマット (引数3 = tiff)
'       詳細は、https://learn.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-consts-formatid
' ------------------------------------------------------------
Function ConvertImageFormat(imgPath As String, newImgPath As String, imgFormat As String) As Boolean
    Dim WIA As Object
    Dim imgFile As Object
    Dim imgProcess As Object
    Dim imgConverted As Object
    Dim fso As Object
    Dim extension As String
    Dim tempFilename As String
    ' エラー発生時の処理
    On Error GoTo ImageConvertError
    ' WIAオブジェクトを作成
    Set imgFile = CreateObject("WIA.ImageFile")
    Set imgProcess = CreateObject("WIA.ImageProcess")
    ' 画像をロード
    imgFile.LoadFile imgPath
    ' 画像のフォーマットを変換
    imgProcess.Filters.Add imgProcess.FilterInfos("Convert").FilterID
    Select Case LCase(imgFormat)
        Case "png"
            extension = "png"
            imgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" ' PNGフォーマットのGUID
        Case "bmp"
            extension = "bmp"
            imgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}" ' BMPフォーマットのGUID
        Case "jpg"
            extension = "jpg"
            imgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}" ' JPEGフォーマットのGUID
        Case "gif"
            extension = "gif"
            imgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}" ' GIFフォーマットのGUID
        Case "tiff"
            extension = "tiff"
            imgProcess.Filters(1).Properties("FormatID").Value = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}" ' TIFFフォーマットのGUID
        Case Else
            ConvertImageFormat = False
            Exit Function
    End Select
    ' Objectにフィルタを適用
    Set imgConverted = imgProcess.Apply(imgFile)
    ' FileSystem オブジェクトの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 拡張子を変更したファイル名を取得する
    newImgPath = fso.GetParentFolderName(newImgPath) & "\" & fso.GetBaseName(newImgPath) & "." & extension
    ' ファイルの有無を確認
    If fso.FileExists(newImgPath) = True Then
        ' ファイルがある場合は、一時的に別名でフォーマット変換する
        ' 別名でフォーマット変換する
        tempFilename = fso.GetParentFolderName(newImgPath) & "\" & fso.GetBaseName(fso.GetTempName) & "." & extension
        imgConverted.SaveFile tempFilename
        ' 元のファイルを削除する
        fso.DeleteFile newImgPath
        ' ファイル名を変更する
        Name tempFilename As newImgPath
    Else
        ' 新しい画像を保存
        imgConverted.SaveFile newImgPath
    End If
    
    ' オブジェクトを解放
    Set imgConverted = Nothing
    Set imgProcess = Nothing
    Set imgFile = Nothing
    Set fso = Nothing
    ConvertImageFormat = True
    Exit Function

ImageConvertError:
    Set imgConverted = Nothing
    Set imgProcess = Nothing
    Set imgFile = Nothing
    Set fso = Nothing
    ConvertImageFormat = False
End Function

【修正】
2024/12/31 ファイルを二度出力していたため、ConvertImageFormatがFalseで戻っていたため、出力個所を修正。画像フォーマットの指定を小文字に変換。(大文字でもOK)

コメント