워드(Doc)문서를 PPT 슬라이드로 변환하기

지난 번에 PPT 를 워드로 변환하는 매크로를 올렸는데

(https://konahn.tistory.com/entry/ConvertPPT)

이번에는 반대로 워드 DOC (혹은 한글 HWP)를 PPT 슬라이드로 변환하는 VBA 매크로입니다.

 

관련 지식인 질문: https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=1020202&docId=346624913&page=1#answer1

 

한글HWP 파일은 워드로 변환저장기능이 있기 때문에 

여기서는 워드를 PPT로 저장하는 데 주안점을 둡니다.

 

워드 document의 각 페이지를 하나의 슬라이드로 붙여넣기 때문에

워드문서를 가로 페이지로 먼저 바꾸고

Ctrl-Enter로 페이지를 미리 나눠주는 게 좋습니다.

 

프리젠테이션으로 변환할 것이기 때문에

글자수는 줄이고 글자크기는 늘리고 도표나 그림 위주로 페이지가 구성될수록 좋습니다.

 

파워포인트 Alt-F11코드창에서 삽입-모듈을 눌러 모듈을 추가하고 아래 코드를 붙여 넣습니다.

Option Explicit

Const Margin As Single = 25 '여백

Sub CopyWord2PPT()
    
    Dim pres As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim SW As Single, SH As Single
    Dim docFile As String
    Dim Word As Object  'Word.Application
    Dim doc As Object   'Word.Document
    Dim rng As Object   'Word.Range
    Dim pg As Long, totalPg As Long, t As Long
    'On Error GoTo Oops:
    
    Set pres = ActivePresentation
    
    '워드파일 선택
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Word Doc file", "*.doc?"
        .InitialFileName = pres.Path & "\"
        If .Show = -1 Then docFile = .SelectedItems(1)
        If .SelectedItems.Count = 0 Then GoTo Oops:
    End With
    
    'Set Word = New Word.Application
    Set Word = CreateObject("Word.Application")
    If Word Is Nothing Then Exit Sub
       
    '워드파일 열기
    Set doc = Word.Documents.Open(FileName:=docFile, ReadOnly:=False, Visible:=True)
    If doc.PageSetup.Orientation = 0 Then   '0=wdOrientPortrait
        pres.PageSetup.SlideOrientation = msoOrientationVertical
    Else
        pres.PageSetup.SlideOrientation = msoOrientationHorizontal
    End If
    SW = pres.PageSetup.SlideWidth
    SH = pres.PageSetup.SlideHeight
    Word.Visible = True
        
    totalPg = doc.Range.Information(4)      '4=wdNumberOfPagesInDocument
    For pg = 1 To totalPg
        '페이지 이동1= wdGoToPage, 1= wdGoToAbsolute
        Set rng = doc.GoTo(What:=1, which:=1, Count:=pg)
        '선택시작
        Word.Selection.GoTo What:=1, which:=1, Count:=pg
        '선택 끝
        rng.End = Word.Selection.Bookmarks("\Page").Range.End
        '복사
        rng.Copy
        
        '슬라이드 추가
        If pg > 1 Then Set sld = pres.Slides.Add(pg, ppLayoutBlank) _
        Else Set sld = pres.Slides(1)
        
        t = sld.Shapes.Count '복사 전 개체 수
        
        '도형으로 삽입
        'sld.Shapes.Paste
        
        ' 워드개체로 삽입
        Set shp = sld.Shapes.PasteSpecial(DataType:=ppPasteOLEObject)(1)
        While sld.Shapes.Count <= t: DoEvents: Wend 'wait until the shape is pasted
        
        '슬라이드에 맞추고 위치 조정
        With shp
            .LockAspectRatio = msoTrue  '가로세로 비율유지
            '일단 높이에 맞추고 폭이 넘으면 폭에 맞춤
            .Height = SH - Margin * 2
            If .Width > (SW - Margin * 2) Then .Width = SW - Margin * 2
            '왼쪽 상단에 맞춤
            .Left = Margin: .Top = Margin
            '가운데로
            '.Left = SW / 2 - .Width / 2
            '.Top = SH / 2 - .Height / 2
        End With
    Next pg

Oops:
    If Err.Number Then MsgBox Err.Description
    If Not Word Is Nothing Then Word.Quit: Set Word = Nothing
End Sub
 

이제 F5키를 누르거나

코드창 닫고 일반 편집화면에서는 Alt-F8로 매크로를 실행합니다.

 

워드파일을 선택하는 창에서 워드파일을 선택합니다.

실행 결과 아래처럼 워드파일이 PPT 슬라이드로 변환됩니다. 워드 개체가 시간이 좀 걸리는 군요.

 

워드의 내용이 PPT에 도형으로 붙여넣을수도 있는데 그 경우 레이아웃이 많이 흐트러지기 때문에

워드를 그대로 워드개체로 PPT슬라이드에 붙여 넣도록 했습니다.

그리고 붙여넣을 때 외곽에 약간의 여백(현재 25)을 주도록 했고

슬라이드 가로폭에 맞게 붙여넣고 만약 슬라이드높이보다 크면 다시 높이에 맞게 줄이도록 했습니다.

변환 전에 슬라이드크기를 변경해주는 것도 좋습니다.

 

PPTM 파일 첨부합니다.

 

CopyDoc2Slide2.pptm

0.04MB

** 2020.05.28 수정사항 **

Object 변수로 수정하였고 wd 변수들을 정수로 변경하여

결과적으로 Word 라이브러리를 도구-참조에서 추가하지 않아도 됩니다.

 

** 워드가 기본 프로그램이 아니거나 파일 로딩시 권한등으로 경고창이 뜨는 경우 제어할 수 없기 때문에 강제 종료해야할 수 있습니다. 또한 워드개체로 붙이지 못하는 경우도 있습니다. 그 때는 아래에서 골라서 붙여넣기 옵션을 조정해보세요.

        'Set shp = sld.Shapes.PasteSpecial(DataType:=ppPasteOLEObject)(1) 
        'Set shp = sld.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)(1)
        'Set shp = sld.Shapes.PasteSpecial(DataType:=ppPasteDefault)(1)