엑셀 VBA를 이용하여 포토샵 이미지 리사이즈 및 저장

매크로 설명

• 엑셀의 VBA 코드를 활용하여 포토샵 이미지를 리사이즈 하고 Export까지 수행하는 매크로이다.
• 인스타그램을 하다보니 최종편집 후 1080 사이즈의 이미지를 만드는 게 귀찮기도 하고,
• 포토샵의 액션 기능을 사용하는 경우 원본 Document의 사이즈에 따라 크기가 제멋대로 나와서 만들어 보았다.
• 가로 이미지와 세로 이미지를 인식하여 장축이 가로인 경우에는 가로가 1080이 되도록,
• 세로가 장축인 경우에는 세로가 1080이 되도록 리사이즈한다.

VBA Code

Option Explicit
Sub resize_image()

Dim appPhoto As Photoshop.Application
Dim docPhoto As Photoshop.Document
Dim imgSize As Double
Dim resizeRate As Double
Dim exportOption As Photoshop.ExportOptionsSaveForWeb
Dim outputPath As String
Dim outFileName As String

outputPath = "E:\"                       '이미지 저장 경로 설정
'outFileName = "resizedIMG.jpeg"          '파일명 설정

imgSize = 1080               '장축의 이미지 사이즈 설정(필요시 직접 설정)

Set appPhoto = New Photoshop.Application '포토샵 개체 선언
Set exportOption = New Photoshop.ExportOptionsSaveForWeb    'Export 옵션 설정
exportOption.Format = psJPEGSave
exportOption.Quality = 100

If appPhoto Is Nothing Then
    MsgBox "error has occured, plz retry"
    Exit Sub
    Else
    appPhoto.Visible = True
End If

appPhoto.Preferences.RulerUnits = psPixels '포토샵의 격자단위를 픽셀(pixel)로 변경
appPhoto.Application.DisplayDialogs = psDisplayNoDialogs '대화상자 끄기


Set docPhoto = appPhoto.ActiveDocument '현재 활성화된 문서를 docPhoto로 선언


With docPhoto
    If .Width >= .Height Then             '가로 이미지인 경우
        resizeRate = imgSize / .Width           '가로를 기준으로 리사이즈 비율 계산
    Else
        resizeRate = imgSize / .Height
    End If
End With

docPhoto.ResizeImage Width:=(docPhoto.Width * resizeRate), _
                     Height:=(docPhoto.Height * resizeRate), _
                     Resolution:=300, _
                     ResampleMethod:=psBicubic


Call docPhoto.Export(outputPath & Split(docPhoto.Name, ".")(0) & ".jpeg", psSaveForWeb, exportOption)



MsgBox "Execution Complete : " & "ResizeRate = " & resizeRate * 100 & "%"

End Sub

매크로 실행 동영상

 Copyright (2018) Ruahneuma. All Rights Reserved.