엑셀 이미지 변환 (크기, 형식, 방향) :: ImageConverter 명령문

'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ ImageConverter 함수
'▶ 이미지의 크기, 형식, 방향을 변환합니다.
'▶ 인수 설명
'_____________strPath                  : 크기, 형식, 방향을 변경할 기존 이미지의 파일 경로입니다. 확장자를 포함한 전체 경로를 입력합니다.
'_____________strNewPath             : 변경 후 새롭게 저장 될 이미지의 파일 경로입니다. 확장자를 포함한 전체 경로를 입력합니다.
'_____________lngFormat               : 변경할 이미지 포맷을 지정합니다. 총 5개의 이미지 형식을 지원합니다.
'_____________KillExists                 : TRUE일 경우 새로운파일경로에 기존 파일이 존재하면 덮어쓰기 합니다.
'_____________lngQuality               : 기본값은 92 입니다. 이미지 품질을 지정하며 100은 최고품질, 0은 최저품질입니다. JPG 포맷으로 변환시에만 적용됩니다.
'_____________dblMaxW               : 변환 될 이미지의 최대 넓이입니다. 기본값은 0 입니다.
'_____________dblMaxH                : 변환 될 이미지의 최대 높이입니다. 기본값은 0 입니다.
'_____________blnFilpH                  : TRUE일 경우 좌우반전이 된 이미지를 반환합니다. 기본값은 FALSE 입니다.
'_____________blnFlipV                  : TRUE일 경우 상하반전이 된 이미지를 반환합니다. 기본값은 FALSE 입니다.
'_____________dblRotation             : 0보다 클 경우 시계방향, 0보다 작을경우 반시계 방향으로 이미지를 회전합니다. 기본값은 0 입니다.
'###############################################################
 
Public Sub ImageConverter(strPath As String, _
                                 Optional strNewPath As String, _
                                 Optional lngFormat As Long = 0, _
                                 Optional KillExists As Boolean = False, _
                                 Optional lngQuality As Long = 92, _
                                 Optional dblMaxW As Double = 0, _
                                 Optional dblMaxH As Double = 0, _
                                 Optional blnFlipH As Boolean = False, _
                                 Optional blnFlipV As Boolean = False, _
                                 Optional dblRotation As Double = 0)
 
'----------------------------------------------------
'변수 설정
'----------------------------------------------------
 
Dim objWIA  As Object                                                                                ' WIA 이미지 파일 오브젝트 입니다.
Dim objIP_1 As Object: Dim objIP_2 As Object: Dim objIP_3  As Object                ' WIA 이미지 프로세싱을 위한 ImageProcess 개체입니다.
Dim strFormat As String: Dim strExt As String                                                   ' 특정 형식의 파일로 저장하기 위한 WIA 파일형식 및 확장자 입니다.
 
'----------------------------------------------------
'오류 검사
'----------------------------------------------------
On Error GoTo EH
 
If lngQuality > 100 Or lngQuality < 0 Then lngQuality = 100
If dblMaxH < 0 Then dblMaxH = 0
If dblMaxV < 0 Then dblMaxV = 0
If IsMissing(strNewPath) Or strNewPath = "" Then strNewPath = strPath
If FileExists(strPath) = False Then GoTo EH_Empty
 
'----------------------------------------------------
'파일형식 및 확장자 선택
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-consts-formatid
'----------------------------------------------------
Select Case lngFormat
    Case 0
        strFormat = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
        strExt = "JPG"
    Case 1
        strFormat = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        strExt = "PNG"
    Case 2
        strFormat = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
        strExt = "BMP"
    Case 3
        strFormat = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
        strExt = "GIF"
    Case 4
        strFormat = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
        strExt = "TIFF"
End Select
 
'----------------------------------------------------
'WIA 이미지 필터 적용
'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-howto-use-filters
'----------------------------------------------------
 
' 1단계 : Conver 함수 (파일 형식을 변경합니다)
 
Set objIP_1 = CreateObject("WIA.ImageProcess")
objIP_1.Filters.Add objIP_1.FilterInfos("Convert").FilterID
objIP_1.Filters(1).Properties("FormatID") = strFormat
objIP_1.Filters(1).Properties("Quality") = lngQuality
 
' 2단계 : RotateFlip 함수 (파일을 반전 또는 회전합니다)
 
If blnFlipH = True Or blnFlipV = True Or lngroation <> 0 Then
    Set objIP_2 = CreateObject("WIA.ImageProcess")
    objIP_2.Filters.Add objIP_2.FilterInfos("RotateFlip").FilterID
    objIP_2.Filters(1).Properties("FlipHorizontal") = blnFlipH
    objIP_2.Filters(1).Properties("FlipVertical") = blnFlipV
    objIP_2.Filters(1).Properties("RotationAngle") = lngRotation
End If
 
' 3단계 : Scale 함수 (파일의 크기를 변경합니다)
 
If dblMaxH <> 0 Or dblMaxV <> 0 Then
    Set objIP_3 = CreateObject("WIA.ImageProcess")
    objIP_3.Filters.Add objIP_3.FilterInfos("Scale").FilterID
    objIP_3.Filters(1).Properties("MaximumWidth") = dblMaxW
    objIP_3.Filters(1).Properties("MaximumHeight") = dblMaxH
End If
 
' 4단계 : 기존 이미지 파일 불러오기 및 필터 적용
 
Set objWIA = CreateObject("WIA.ImageFile")
objWIA.LoadFile strPath
 
Set objWIA = objIP_1.Apply(objWIA)
If Not objIP_2 Is Nothing Then Set objWIA = objIP_2.Apply(objWIA)
If Not objIP_3 Is Nothing Then Set objWIA = objIP_3.Apply(objWIA)
 
'----------------------------------------------------
'변경된 이미지 파일 저장
'----------------------------------------------------
' 파일명 설정
strNewPath = Left(strNewPath, InStrRev(strNewPath, ".")) & LCase(strExt)
 
' 기존 파일 삭제여부 체크 (삭제여부 False이고 기존파일 존재시 오류 반환)
If KillExists = True And FileExists(strNewPath) = True Then Kill strNewPath
 
' 파일 저장 및 명령문 종료
objWIA.SaveFile strNewPath
 
EH_Exit:
    On Error Resume Next
    If Not objIP_1 Is Nothing Then Set objIP_1 = Nothing
    If Not objIP_2 Is Nothing Then Set objIP_2 = Nothing
    If Not objIP_3 Is Nothing Then Set objIP_3 = Nothing
    If Not objWIA Is Nothing Then Set objWIA = Nothing
    Exit Sub
 
'----------------------------------------------------
'오류 처리
'----------------------------------------------------
 
EH_Empty:
   MsgBox "입력한 파일이 존재하지 않습니다.", vbOKOnly + vbCritical
   GoTo EH_Exit
 
EH:
    MsgBox "오류가 발생하였습니다." & vbNewLine & vbNewLine & _
           "발생위치 : " & "ImageConverter" & vbNewLine & _
           "오류번호 : " & Err.Number & vbNewLine & _
           "오류상세 : " & Err.Description, vbCritical
    GoTo EH_Exit
 
End Sub
 
 
Public Function FileExists(ByVal path_ As String) As Boolean
 
'########################################################
'입력한 파일경로에 파일 존재여부를 확인합니다.
'https://www.oppadu.com/vba-fileexists-함수/
'########################################################
 
    FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function