엑셀 데이터로 파워포인트 차트 일괄 생성

 

통합 문서1.xlsx 파일에서 한 행씩 추출해서

파워포인트에 슬라이드를 추가하고

세로 막대 그래프를 생성하는 예제입니다.

​

차트 생성은 엑셀에 의존하는 작업이라 약간의 시간이 소요됩니다.

또한 작업 중에 창을 건드리면 오류가 날 수 있습니다.

​

내부적으로 슬라이드에 차트를 추가하고

데이터 입력 엑셀창에서 통합문서1.xlsx파일 엑셀 시트의 값들을 한 행씩 복사해서

SetSourceData로 차트에 반영될 데이터 영역을 지정해주고 있습니다.

 

Option Explicit

'AddChart2
'ChartData 엑셀에 데이터를 붙여넣는 방식

Sub AddCharts()

    Dim xlsApp As Object
    Dim xlsBook As Object, pptBook As Object
    Dim xlsSht As Object, pptSht As Object
    Dim xlsName As String
    Dim rng As Object
    Dim LastRow As Long, LastCol As Long

    Dim pres As Presentation
    Dim Sld As Slide
    Dim shp As Shape
    Dim SW!, SH!, m!
    Dim i As Integer
    Dim srs As Series
    Dim Cols() As Long
    Set pres = ActivePresentation
    xlsName = pres.Path & "\통합 문서1.xlsx"
    
On Error GoTo Oops
    Set xlsApp = CreateObject("Excel.Application")
    Set xlsBook = xlsApp.Workbooks.Open(xlsName)
    Set xlsSht = xlsBook.Worksheets(1)
    
    '마지막 행과 열
    LastRow = xlsSht.Cells(xlsSht.Rows.Count, "A").End(-4162).Row       '-4162: xlUp
    LastCol = xlsSht.Cells(1, xlsSht.Columns.Count).End(-4159).Column   '-4159: xlToLeft
    If LastRow < 2 Then Exit Sub
    
    '슬라이드 크기
    With pres.PageSetup
        SW = .SlideWidth: SH = .SlideHeight
    End With
    m = 100 '여백
    
    '랜덤 막대 색깔
    Randomize
    ReDim Cols(1 To LastCol - 1)
    For i = 1 To LastCol - 1
        Cols(i) = RGB(125 + Rnd * 125, 125 + Rnd * 125, 125 + Rnd * 125)
    Next
    
    'A열 순환
    For Each rng In xlsSht.Range("A2:A" & LastRow)
        
        Set Sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutBlank)
        Set shp = Sld.Shapes.AddChart2(201, xlColumnClustered, m, m, SW - 2 * m, SH - 2 * m)
        With shp.Chart
            '.ChartType = xlLine                '선
            '.ChartType = xl3DBarClustered      '가로 3D막대
            '.ChartType = xl3DColumn            '세로 3D막대
            .ChartType = xlColumnClustered      '차트Typee
            .HasLegend = False                  '범례
            .HasTitle = True
            .ChartTitle.Text = rng              '차트 제목
            .Name = "Table1"                    '도형이름
            .PlotBy = xlColumns                 '열 기준
            
            '.ChartData.Activate
            Set pptBook = .ChartData.Workbook   '데이터 창의 엑셀
            Set pptSht = pptBook.Worksheets(1)  '데이터 창의 Sheet 1
            pptSht.Cells.Clear
            
            
            '기본으로 추가되는 기존 데이터 모두 삭제
            'While .SeriesCollection.Count
            '    .SeriesCollection(.SeriesCollection.Count).Delete
            'Wend
            
            pptSht.Range("B1:" & xlsSht.Cells(1, LastCol).Address).Value = _
                xlsSht.Range("B1:" & xlsSht.Cells(1, LastCol).Address).Value
                
            pptSht.Range("A2") = rng
            
            pptSht.Range("B2:" & xlsSht.Cells(2, LastCol).Address).Value = _
                xlsSht.Range(rng.Offset(, 1), xlsSht.Cells(rng.Row, LastCol)).Value
            
            '=Sheet1!$A$1:$H$2
            .SetSourceData pptSht.Name & "!$A$1:" & xlsSht.Cells(2, LastCol).Address
            DoEvents
            
            '최대/최소값과 단위
            .Axes(2).MaximumScale = 100     '2:xlValue, 1:xlCategory
            .Axes(2).MinimumScale = 0       '2:xlValue, 1:xlCategory
            .Axes(2).MajorUnit = 10
            
             '첫번째 계열
            With .SeriesCollection(1)

                '막대 색깔 변경
                For i = 1 To LastCol - 1
                    .Points(i).Format.Fill.ForeColor.RGB = Cols(i)
                Next i
                
                '라벨
                .ApplyDataLabels
            End With

            '.ChartData.Workbook.Close   '데이터 엑셀창 닫기
            pptBook.Close
        End With
        'Exit For
    Next rng
    
    MsgBox "All done!"
    
Oops:
    If Err Then MsgBox Err.Description
    If Not xlsBook Is Nothing Then xlsBook.Close
    If Not xlsApp Is Nothing Then xlsApp.Quit: Set xlsApp = Nothing
    
End Sub

 

통합 문서1.xlsx에 데이터를 입력하시고

첨부한 pptm을 매크로 허용해서 여시고 Alt-F8누른 다음에 AddCharts 를 실행하세요.

데이터의 개수 즉 행이나 열개수는 늘어나도 됩니다.

작업시간이 약간 소요되는데 작업이 끝나면 All done 이라는 메시지창이 뜹니다.

 

통합 문서1.xlsx

0.01MB

AddChart1.pptm

0.12MB

 

참고

 

- 차트에 데이터를 입력할 때 SetSurceData 를 이용하지 않고

SeriesCollection 을 추가해서 값을 직접 넣어줄 수도 있습니다.

(pptm 파일의 Module2 참고)

 

- AddChart2 함수이전에는 AddChart 함수를 사용했었습니다.

(Module3 참고)

 

- 차트는 엑셀에 의존하기 때문에 시간이 걸리고

개체 오류도 발생하기 쉽습니다.

데이터 창이 뜨는 것을 제어해줘야 합니다.

 

- 차트의 종류를 바꾸거나 

차트 색깔 변경, 최대값/최소값 변경, 단위 변경 등은 주석을 참고하세요.

 

 

 

 

관련: 지식인