엑셀 PPT 자동화 - egsel PPT jadonghwa

- 엑셀매크로(VBA)로 파워포인트 문서 생성

많은 양의 규칙적인 엑셀 데이터를 가지고, 파워포인트 슬라이드를 생성하는 자동화코드를 공유합니다.

(제가 직접 연구하고 테스트 끝낸 코드입니다.)

일일이 수작업으로는 거의 불가능한 일을 단 몇십초만에 가능하게 하는

자동화의 끝판왕이라고 하겠네요.

아래와 같은 엑셀 데이터를 PPT 문서로 인쇄합니다.

1) 데이터

2) 실행 결과 (PPT생성)

'전체 코드 

'응용해서 이용하시면 되겠습니다. (물론 VBA에 지식이 어느정도 있는 분들만..)

필수:  엑셀-Alt+F11> VBA에디터 > 도구- 참조 > 'MicroSoft PowerPoint 1X.X Object Library" 체크돼 있어야 합니다.

'엑셀 리스트를 파워포인트 슬라이드로 뿌린다

Sub ExcelRangeToPowerPoint()

Dim PowerPointApp As PowerPoint.Application

Dim myPresentation As PowerPoint.Presentation

Dim mySlide As PowerPoint.Slide

'===========================

Dim i As Integer

Dim BoxEntry As PowerPoint.Shape, BoxPronun As PowerPoint.Shape, BoxMean As PowerPoint.Shape, BoxIDX As PowerPoint.Shape

Dim strEntry As String, strPron As String, strMean As String, strPOS As String, strIDX As String

Dim r As Range, rng As Range

'===========================

  Set rng = Sheet3.Range("C2:C33") '리스트 영역

'=====================================

  On Error Resume Next '

      Set PowerPointApp = GetObject(class:="PowerPoint.Application")    '파워포인트가 이미 열렸나?

      Err.Clear 'Clear the error between errors

      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")

      If Err.Number = 429 Then '

        MsgBox "PowerPoint could not be found, aborting."

        Exit Sub

      End If

  On Error GoTo 0

  '=====================================

  PowerPointApp.Visible = True '파워포인트 보이기

  PowerPointApp.Activate '

  Set myPresentation = PowerPointApp.Presentations.Add '새 PPT 문서 생성

For Each r In rng 'C열 단어열 순환

    i = i + 1

    strIDX = Replace(r.Offset(0, -2).Value, "idx", "")

    strEntry = r.Offset(0, 0).Value

    strPron = r.Offset(0, 1).Value

    strPOS = r.Offset(0, 2).Value

    strMean = r.Offset(0, 3).Value

'------------------------------------------

  Set mySlide = myPresentation.Slides.Add(1, ppLayoutBlank) '슬라이드1장씩 추가

    With mySlide

        .BackgroundStyle = 1

        .Background.Fill.ForeColor.RGB = RGB(20, 20, 20)

    End With

'---------------텍스트 상자 생성> 텍스트 입력---------------------------

  Set BoxIDX = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=50, Top:=80, Width:=600, Height:=50)

  With BoxIDX.TextFrame.TextRange

      .Text = strIDX

      .Font.Bold = True

      .Font.Size = 35

      .Font.Color.RGB = RGB(204, 255, 255)

      .ParagraphFormat.Alignment = ppAlignCenter

    End With

  Set BoxEntry = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=50, Top:=150, Width:=600, Height:=80)

  With BoxEntry.TextFrame.TextRange

      .Text = strEntry

      .Font.Bold = msoCTrue

      .Font.Size = 75

      .Font.Color.RGB = RGB(255, 212, 132)

      .ParagraphFormat.Alignment = ppAlignCenter

    End With

  Set BoxPronun = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=50, Top:=250, Width:=600, Height:=50)

    With BoxPronun.TextFrame.TextRange

      .Text = strPron

      .Font.Size = 40

      .Font.Color.RGB = RGB(204, 255, 204)

      .ParagraphFormat.Alignment = ppAlignCenter

    End With

    Set BoxMean = mySlide.Shapes.AddTextbox(msoTextOrientationHorizontal, Left:=50, Top:=330, Width:=600, Height:=50)

        With BoxMean.TextFrame.TextRange

            .Text = "[" & strPOS & "]" & strMean

            .Font.Size = 28

            .Font.Color.RGB = RGB(204, 255, 255)

            .ParagraphFormat.Alignment = ppAlignCenter

        End With

Next r

    Set myPresentation = Nothing

    Set PowerPointApp = Nothing

     MsgBox i & "장 슬라이드 생성완료!"

End Sub