[VBA] 사진 이미지 사이즈 변경하기

쇼핑몰 이미지 사이즈 변환 요청에서 사용한 코드를 올릴려고 한다.

 

당시 응용한 코드는 오빠두님이 올려주신 코드를 참고하였다.

https://www.oppadu.com/%EC%97%91%EC%85%80-%EC%9D%B4%EB%AF%B8%EC%A7%80-%EB%B3%80%ED%99%98/

엑셀 이미지 변환 (크기, 형식, 방향) :: ImageConverter 함수 - 오빠두엑셀

당시에는 납기도 좀 빠듯해서 저 코드를 복붙하였지만, 다시 코드를 복기하는 차원으로

좀 더 심플하게 만들어 보았다..

 

엑사남님과 오빠두님 다잡님..그리고 이제 인정하기 싫지만 준빠님(라이벌에서 이젠 발 뒤꿈치도 못따라감 ㅠ.,ㅜ) 그리고

구글신께서 나를 붙잡아주신다..ㅋㅋ

코드 진행은 이렇다.

1. 폴더를 선택한다. (폴더 선택하는 코드는 그냥 통으로 외워라... 이해하지마 그냥 외웁시다)

2. Wia.ImageProcess 로 사진의 속성을 파악하고

3. Wia.ImageProcess 로 사진을 변형한 후

4. 저장한다. (다른 폴더에 저장하는걸 하려했으나.. 계속 실패해서 그냥 같은 폴더에 이름 바꿔서 저장했다.ㅠ.,ㅜ)

폴더명 / 파일명 / 확장자명 / 이미지 높이 / 이미지 너비가 보인다

 

 

Wia.ImageFile로 할 수 있는 퍼포먼스들이 보인다. 여기서 본인은 

 

필터의 스케일만 가져왔다.

자주 쓰는 코드들이 아니기 때문에 아 VBA도 이게 가능하구나 정도만 생각하고 넘어 가길 바란다.

Option Explicit

Sub imgInfo()

    Dim strPath$
    Dim FileName$
    Dim Cnt&
    Dim Img As Object
    Dim IP As Object
    Dim outFile$, TempPath$
    Dim W&, H&
    
   '================================ 사진 폴더 선택 =================================
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            strPath = .SelectedItems(1) & "\"
        End If
        
        FileName = Dir(strPath)
        
        If FileName = "" Then
            MsgBox "폴더에 파일이 없습니다."
            Exit Sub
        End If
    End With
    
   '=========================== 선택된 폴더 속 사진 파일 순환 =========================
    Do While FileName <> ""
       '= 파일속 이미지 파일만 필터
        If InStr(1, FileName, ".jpg") + InStr(1, FileName, ".png") + InStr(1, FileName, ".img") + InStr(1, FileName, ".ioc") + InStr(1, FileName, ".bmp") > 0 Then
            Cnt = Cnt + 1                                   '= 파일명 카운팅 하기 위해서
           
            
            Set IP = CreateObject("WIA.ImageProcess")       '= 이미지 파일의 속성값 추출
            Set Img = CreateObject("WIA.ImageFile")         '= 이미지 파일의 변경하려는 옵션
            
            Img.LoadFile strPath & FileName                 '= 이미지 파일을 불러와라
            IP.Filters.Add IP.FilterInfos("Scale").filterid '= 이미지 파일의 변경 옵션중 [스케일] 옵션 적용
            
            W = Img.Width                                   '= 불러온 이미지값의 너비
            H = Img.Height                                  '= 불러온 이미지값의 높이
            
            If W <> 0 Then IP.Filters(1).Properties("MaximumWidth") = 860   '= 너비 값이 0이 아니면 너비 최대값을  860으로 고정해라
            If H <> 0 Then IP.Filters(1).Properties("MaximumHeight") = (860 * H) / W  '= 너비 값을 860으로 고정하고 높이는 그에 맞게 변경해라
        
                Set Img = IP.Apply(Img)                     '= 변경된 이미지를 적용해라
                    outFile = strPath & "Re_" & Cnt & "." & Img.FileExtension
                                                            '= 변경된 이미지의 새로운 네이밍을 해라
                    Img.SaveFile outFile                    '= 이미지를 해당 폴더에 저장해라
        End If
        
    FileName = Dir                                          '= 다음 이미지 파일로 순환해라
    Loop
End Sub

이미지사이즈변경.xlsm

0.02MB