슬라이드 크기 변경할 때 자동으로 개체 가로:세로 비율 적용하기

디자인 > 슬라이드 크기에서 예를 들어  A4가로 크기를 16:9가로로 사이즈를 바꿀 때

최대화 의 경우

'최대화'를 적용하면 개체의 위 아래가 슬라이드 세로 높이를 벗어나고

 

맞춤 확인의 경우

'맞춤확인'으로 선택하면 슬라이드 좌/우에 여백이 생깁니다.

​

이럴 때 아래 VBA를 이용해서 일괄로 개체의 가로, 세로 크기와 위치를

슬라이드 크기에 가득차게 맞춤 조정해 보세요.

​

A4프리젠테이션에서 Alt-F11 누르고 삽입 > 모듈을 추가하고

아래 코드를 붙여넣고 F5로 실행하면

현재 프리젠테이션을 복제하고 나서 슬라이드 크기를 16:9로 만들고

개체의 크기를 새 슬라이드에 가득차게 계산해서 변경시켜줍니다.

(만들어질 슬라이드의 크기를 A4나 4:3으로 바꾸려면 .SlideSize 를 주석을 참고하여 수정할 것!)

 

Option Explicit

Sub ChangeSlideSize()

    Dim pres As Presentation, pres1 As Presentation
    Dim sld As Slide, sld1 As Slide, shp As Shape, shp1 As Shape
    Dim SW!, SH!, SW1!, SH1!, i As Integer
    
    'Original Presentation
    Set pres = ActivePresentation
    With pres.PageSetup
        SW = .SlideWidth
        SH = .SlideHeight
    End With
    
    'New Presentation
    Set pres1 = Presentations.Open(FileName:=pres.FullName, ReadOnly:=msoFalse, _
                        Untitled:=msoTrue, WithWindow:=msoTrue)
    With pres1.PageSetup
        .SlideSize = ppSlideSizeOnScreen16x9   '// 16:9
        SW1 = .SlideWidth
        SH1 = .SlideHeight
    End With
 
    'Adjust the size and location of each shape in slides according to the rate
    For Each sld1 In pres1.Slides
        Set sld = pres.Slides(sld1.SlideIndex)
        i = 0
        For Each shp1 In sld1.Shapes
            i = i + 1	'수정 240810
            Set shp = sld.Shapes(i)
            With shp1
                .LockAspectRatio = msoFalse
                .Width = SW1 / SW * shp.Width
                .Height = SH1 / SH * shp.Height
                .Left = SW1 / SW * shp.Left
                .Top = SH1 / SH * shp.Top
            End With
        Next shp1
    Next sld1
    
End Sub

실행 전(좌)과 실행 후(우)

단, 폰트 크기는 파워포인트가 자체적으로 크기를 변경한 대로 둡니다.

​

실행 화면  캡쳐

 

첨부한 샘플파일을 참고하세요.

 

** [2024.08.10 수정] 슬라이드 번호 등이 있는 경우 도형의 ZOrderPosition이 일반적인 규칙과 달라 오류가 발생하는 상황을 고려하여 도형의 Index로 도형을 찾도록 수정하였습니다.

ChangeSlideSize1.pptm

0.08MB