ppt를 그림 프리젠테이션으로 저장

파워포인트 그림 프리젠테이션

 

프리젠테이션에 애니메이션은 없는 경우 글꼴모양을 유지하고 싶을 때

폰트를 포함하기에는 ppt 파일이 너무 커지고 글꼴파일을 수동으로 설치하기도 귀찮고 글꼴을 유지하고 싶을 때

파워포인트 프리젠테이션을 '다름이름으로 저장'에서 '그림 프리젠테이션'으로 저장하면

각 슬라이드를 이미지로 저장해서 ppt를 만들어줍니다. 

 

그런데 그림 프리젠테이션으로 저장한 경우 각 슬라이드 이미지의 해상도가 상당히 낮은 편이어서 확대시에 이미지가 깨질 수 있고 JPG형태라 깔끔하지 않습니다.

 

물론 수동으로 각 슬라이드를 일단 png등의 그림으로 저장한 다음 삽입 - 사진 앨범 기능으로 저장한 이미지를 삽입하는 식으로 2단계에 걸쳐서 그림 프리젠테이션을 만들 수도 있습니다.  이 경우도 그림의 해상도를 높히는 것이 레지스트리를 수정하거나 따로 매크로를 이용해야 합니다.

 

그래서 위 2단계 작업을 VBA로 한번에 자동으로 처리하게 만들었습니다.

 

✨ 사용 방법:

 

1. 일단 첨부한 pptm 매크로파일을 매크로 허용해서 엽니다.(외부에서 받은 pptm파일은 탐색기에서 파일 우클릭후 속성에서 '차단해제' 후 적용/확인 하는 것이 좋습니다.)

 

2. 그 다음 사용자의 파워포인트 파일을 엽니다.

 

3.개발도구에서 매크로를 누르거나 Alt-F8 을 누릅니다.

매크로 창에서 매크로 위치를 먼저 열었던 pptm 파일로 선택하고

SaveAs 매크로를 실행합니다.

 

그리고 아래 이미지 선택에서 원하는 이미지 형식을 선택하면 됩니다. 이미지 형식에 따라 슬라이드 이미지의 선명도가 달라집니다.

 

 

주의: 여기서 EMF방식은 설치된 폰트를 이용해서 확대/축소가 가능한 방식이므로 시스템에 해당 폰트가 없으면 글꼴이 다른 걸로 바뀔 수 있으니 유의하세요. 호환성을 위해서는 PDF로 내보내기하는 것이 좋습니다.

 

작업이 완료되면 새 그림 프리젠테이션 파일이 열립니다. 파일명은 'New_기존파일명.pptx' 형식입니다.

 

코드 더보기:

 

Option Explicit

'True 이면 프로그래스바 표시,  호환성을 위해 꺼둠.
Const ProgressBarOn As Boolean = False

'제본시 왼쪽 여백
Const BindingMargin As Single = 0   '30

'이미지 저장방식: PNG, JPG, EMF등 emf 추천
'Const ImgType = "EMF"
Sub SaveAS()
    
    UserForm2.Show 'vbModeless
    
End Sub

Function SaveAsImagePresentation(ImgType As String)
   
    
    Dim oldPPT As Presentation, newPPT As Presentation
    Dim oldLayouts As CustomLayouts
    Dim i As Long
    Dim SW As Single, SH As Single, nWidth As Single, nHeight As Single
    Dim dPath As String, Fname As String, Pname As String, Bname As String
    Dim sld As Slide, newSld As Slide, shp As Shape
    Dim x As Single, y As Single, w As Single, h As Single
      
    '//현재 프리젠테이션
    Set oldPPT = ActivePresentation
    Fname = oldPPT.Name
    Bname = Left(Fname, InStrRev(Fname, ".") - 1)   '확장자 없이 이름만 추출
    
    '//새 프리젠테이션 열기
    dPath = oldPPT.path & "\"
    Set newPPT = Presentations.Add(WithWindow:=msoTrue)
    If newPPT Is Nothing Then GoTo ErrMsg
    
    '//페이지설정 복사
    With newPPT.PageSetup
        .SlideOrientation = oldPPT.PageSetup.SlideOrientation
        .SlideSize = oldPPT.PageSetup.SlideSize
        .SlideWidth = oldPPT.PageSetup.SlideWidth
        .SlideHeight = oldPPT.PageSetup.SlideHeight
        SW = .SlideWidth: SH = .SlideHeight
    End With
    
    '비트맵 그림 저장시 확대비율
    'Ratio = 96 / 72 * 4                '*4배로 늘려서 좀더 높은 해상도로 저장
    nWidth = 3072                       '2010에서 최대 3072px, 2019이상은 8192px 이상 가능
    nHeight = SH * nWidth / SW
      
    '프로그레스바 띄우기
    If ProgressBarOn Then UserForm1.Show vbModeless
      
    On Error GoTo ErrMsg

    '//모든 슬라이드에 대해 순환
    i = 1
    For Each sld In oldPPT.Slides
        
        '기존 슬라이드 이미지로 저장
        Pname = Bname & i & "." & ImgType
        
        If ImgType Like "EMF" Then
            sld.Export dPath & Pname, ImgType
        Else
            sld.Export dPath & Pname, ImgType, nWidth, nHeight
        End If
        
        '새 슬라이드 추가
        Set newSld = newPPT.Slides.Add(i, ppLayoutBlank)
        
        '기존 디자인 복사하려면 주석 제거
        'newSld.Design = sld.Design
        
        'image 붙이기
        h = SH:         y = 0:        w = SW:        x = 0
        
        '제본용으로 인쇄시 홀수페이지는 왼쪽에, 짝수페이지는 오른쪽에 BindingMrgin 추가
        If i Mod 2 = 1 Then
            x = x + BindingMargin
            w = w - BindingMargin
        Else
            w = w - BindingMargin
        End If
        Set shp = newSld.Shapes.AddPicture(dPath & Pname, msoFalse, msoTrue, x, y, w, h)
        shp.Name = Pname
        
        Kill dPath & Pname  '각 슬라이드 이미지 삭제
                 
        '프로그레스 바 업데이트
        If ProgressBarOn Then
            UserForm1.ProgressBar1.Value = Int((i / oldPPT.Slides.Count) * 100)
            UserForm1.Label1.Caption = Bname & ".pptx"
            UserForm1.Repaint
        End If
        
        i = i + 1

    Next sld

    newPPT.SaveAS FileName:=dPath & "New_" & Bname & ".pptx", FileFormat:=ppSaveAsDefault
    
    If i > 1 Then MsgBox i - 1 & "개의 이미지 슬라이드 복사본를 생성하였습니다:" & vbNewLine & _
        dPath & "New_" & Bname & ".pptx"
    
ErrMsg:
    If Err.Number Then MsgBox Err.Description
    Set newPPT = Nothing
    If ProgressBarOn Then Unload UserForm1

End Function

 

- 제본을 할 경우 BindingMargin값을 수정하면 홀수,짝수페이지 마다 왼쪽/오른쪽에 여백을 적용할 수 있습니다.

- 작업진척도를 보여주는 ProgressBar 는 호환성을 위해 꺼놨습니다.

- PNG나 JPG로 각 슬라이드를 임시로 저장할 때 가로 3072px로 저장합니다. 파워포인트 버전 2019나 365등에서 더 높은 비트맵 해상도를 원하면 nWidth 값을 8192 등으로 높힐 수 있습니다. EMF 는 확대가 가능한 벡터방식이라 따로 지정할 필요가 없습니다. 인쇄용으로는 EMF방식을 추천합니다. 하지만 emf 내부에 텍스트가 들어 있는 경우 폰트가 없으면 글자가 원하는 폰트로 나오지 않을 수 있습니다.

 

아래 파일을 다운받아 매크로 허용해서 여세요.

 

SaveSlides2ImgWithMargin2.pptm

0.14MB