[파워포인트 매크로] 폴더 안의 이미지 확장자 일괄변경 매크로

매크로 설명

• 선택한 폴더 내의 이미지 파일 확장자를 변경하는 매크로.
• 선택한 폴더 안에서 미리 설정한 확장자(예컨대, JPG)를 원하는 확장자(예컨대, PNG)로 다시 저장해주는 매크로.
• 일일이 파일을 불러와서 저장할 필요없이 일괄적으로 변경 가능하다.
• 아래 VBA Code 중 폴더를 선택하고 폴더 내 파일들을 순환하는 코드는 니꾸님의 블로그를 참조하였음을 밝힌다.

매크로 실행 동영상(실행 방법 포함)

VBA Code

Sub img_batch_convert()
Dim myFileName As String '불러올 파일명 변수
Dim strPath As String '불러올 파일이 있는 경로변수
Dim myFormat As String '불러올 파일의 확장자 변수
Dim targetFormat As String '저장할 파일의 확장자 변수
Dim varFiles()
Dim v As Long, i As Long
Dim myShape As Shape

 With Application.FileDialog(msoFileDialogFolderPicker)  '폴더선택 창에서
        .Show                                          '폴더 선택창 띄우기
        If .SelectedItems.Count = 0 Then      '취소 선택 시
            Exit Sub                                    '매크로 종료
        Else                                             '폴더 선택시
            strPath = .SelectedItems(1) & "\" '폴더 경로를 변수에 넣음
        End If
End With

myFormat = ".jpg"     'jpg 포맷을
targetFormat = ".png"    'png 포맷으로
myFileName = Dir(strPath & "*" & myFormat) 'strPath 경로의 첫 번째 파일을 반환

If myFileName = "" Then
        MsgBox "폴더에 파일이 없습니다."   '메시지 출력
        Exit Sub                                        '매크로 중단
End If

Do While myFileName <> ""                      '이름이 없지 않다면, 즉, 엑셀파일이 존재하면
        v = v + 1                                        '배열크기 1씩 늘려감
        ReDim Preserve varFiles(1 To v)      '배열값 유지하며 크기 재설정
        varFiles(v) = myFileName                     '다음 파일을 파일이름에 넣음
        myFileName = Dir                            
        'Dir을 생략하면 이전에 지정한 같은 Path 내의 다른 파일을 호출한다. 초기 호출시에는 경로를 지정해줘야 한다.
Loop


For i = 1 To UBound(varFiles)
    Set myShape = ActivePresentation.Slides(1).Shapes.AddPicture(strPath & varFiles(i), msoFalse, msoTrue, 0, 0)
    'Link to File 파라미터가 msoFalse인 경우 SaveWithDocument 파라미터는 msoTrue여야 오류 안남.
    myShape.Select
    myShape.Export strPath & Split(varFiles(i), myFormat, -1)(0) & targetFormat, _
                                                 ppShapeFormatPNG, , , _
                                                 ppScaleToFit 'PNG 포맷으로 저장
    myShape.Delete
Next
   
Set myShape = Nothing
   
End Sub

 Copyright (2018) Ruahneuma. All Rights Reserved.