[파워포인트 VBA] 그림 크기 일괄 변경하기 (엑셀에서 제어)

매크로 설명

• 기존 포스팅에서 이와 유사한 매크로를 다루었지만,
• 사소하지만 꽤나 중대한 문제가 있었기에 리뉴얼해서 올린다.
• 사소하지만 꽤나 중대한 문제라 함은, 기존에 만든 매크로의 경우 파워포인트 프로그램에서 실행된다.
• 이 경우 해당 PPT 파일을 매크로가 사용가능한 .pptm으로 변경하고 코드를 복붙하고 실행해야 하는 번거로움이 있었다.
• 이를 해결하기 위해 엑셀을 통해 PPT 파일을 제어하도록 변경한 매크로이다.
• 정상적으로 작동하려면 PowerPoint Object Library 참조를 추가해주어야 한다.
• VBA 편집기 화면 -> 도구 -> 참조 -> Microsoft PowerPoint ##.# Object Library를 찾아서 체크 -> 확인

매크로 실행 동영상

VBA Code

Option Explicit
Sub picBatch()
Dim i As Long, cnt As Long
Dim pptFilePath As String
Dim pic As Object
Dim myPPTapp As PowerPoint.Application
Dim myPPTdoc As PowerPoint.Presentation
  With Application.FileDialog(msoFileDialogFilePicker) '파일 선택 대화창 오픈
    .Show
    If .SelectedItems.Count < 1 Then '선택한 파일이 없는 경우
      Exit Sub 'VBA 종료
    Else '파일을 선택한 경우
      pptFilePath = .SelectedItems(1) '선택한 파일의 경로 + 파일명 + 확장자까지 입력
      Set myPPTapp = CreateObject("PowerPoint.Application") '파워포인트 응용프로그램 초기화
      Set myPPTdoc = myPPTapp.Presentations.Open(pptFilePath) '해당 파워포인트 파일 실행
    End If
  End With
 
  For i = 1 To myPPTdoc.Slides.Count '전체 슬라이드를 돌면서
    For Each pic In myPPTdoc.Slides(i).Shapes '각 슬라이드의 Shapes 중에서
      If pic.Type = msoPicture Then '특정 Shape가 그림인 경우
        With pic
          .LockAspectRatio = msoFalse '가로/세로 비율고정 해제
          .Width = 200 '가로 이미지 크기
          .Height = 300 '세로 이미지 크기
        End With
      End If
    Next pic
  Next i
  
  Set myPPTdoc = Nothing
  Set myPPTapp = Nothing
  MsgBox "이미지 크기가 모두 변경되었습니다."
End Sub

 Copyright (2018) Ruahneuma. All Rights Reserved.