[Chart Merge] 차트 복제하여 엑셀 데이터 일괄 반영

관련: 지식인

 

차트를 복사해서 다른 데이터 영역을 반영하고 싶을 때

수작업으로 하려면 차트를 계속 복사하고

'데이터 선택'을 눌러서 다른 셀 영역을 계속 선택해주면 됩니다.

이 때 만일 변경할 데이터가 너무 많다면 VBA를 이용해야겠습니다. 마치 한글에서 메일머지 기능을 이용하듯이 엑셀 양식에 데이터를 넣어두고 파워포인트에는 차트를 복사해서 양식을 갖춰 놓은 상태에서 매크로로 슬라이드(차트)복사 후 엑셀 데이터 업데이트 작업을 일괄 처리합니다.

​

차트개체는 가로세로 방향, 추가된 개체, 서식 등이 모두 다르기 때문에 상황에 따라 변수가 있을 수 있지만 주된 흐름은 아래 방법을 이용해서 처리할 수 있겠습니다.

​

여기서는 엑셀에 데이터가 4개의 세트가 있고

파워포인트에 복사된 차트('Chart 1'이라는 이름)가 하나 1슬라이드에 있을 때

4번에 걸쳐 1슬라이드를 계속 복제한 다음

해당 슬라이드의 Chart 1 차트 내용을 엑셀의 다음 영역의 데이터를 각각 반영한다고 가정합니다.

​

(한 가지 더 고려할 것이 있는데, 자세히 보니 데이터 라벨을 표시하도록 했는데 G열의 데이터를 라벨에 포함하도록 하고 있네요. 조금 복잡해지지만 이것도 반영하도록 했습니다.)

​

VBA에서 데이터 원본 소스 변경은

차트.SetSourceData <셀영역> 이 부분이 핵심입니다.

​

4번 순환하면서 위 명령을 이용해 기존 데이터 영역크기만큼 아래 셀영역을 다음 데이터소스영역으로 지정해주면 됩니다.

여기서 주의할 것은 데이터 반영 전에 반드시 엑셀 창을 활성화시켜줘야 자료가 반영됩니다.

​

매크로 실행 영상을 확인하세요. 파워포인트는 차트 작업에 있어 엑셀에 의존하기 때문에 작업 처리 시간이 좀 걸립니다.

 

특히 데이터라벨이 있는 경우 여기서는 G열의 해당열들의 값이 나타나도록 반영했습니다.

반영할 주소가 다르다면 코드를 수정해야 합니다. 이 부분은 엑셀파일상황에 따라 변수가 있습니다.

​

엑셀에서 차트를 다루는 것보다 파워포인트 VBA 에서는 조금 더 손이 가는 것이 사실입니다.

잘 안될 경우에는 엑셀에서 매크로를 녹화해서 참고하면 됩니다.

 

Option Explicit

'Const xlFile = "PPT 연동용 엑셀 예시.xlsx"
'Const xlRange = "B2:D5"
Const ChartName = "Chart 1" '차트 개체 이름

Sub ManipulateChart()

    Dim xlSht As Object
    Dim xlRange As Object, xlNewRange As Object
    Dim sRange As String
       
    Dim sld As Slide, sldNew As Slide
    Dim shp As Shape
    Dim cht As Chart
    Dim srs As Series, DtLabel As DataLabel
    Dim i As Integer, j As Integer, k As Integer
    
    Set sld = ActiveWindow.View.Slide

    For i = 1 To 4  '4번 반복
        
        '슬라이드 복제
        Set sldNew = sld.Duplicate(1)
        sldNew.MoveTo sld.Parent.Slides.Count
        Set shp = sldNew.Shapes(ChartName)
        Set cht = shp.Chart
        
        '엑셀 창 띄우기(필수)
        cht.ChartData.ActivateChartDataWindow
        
        '차트 소스데이터 range 구하기
        sRange = getSourceData(cht) '  "B2:D5"
        
        Set xlSht = cht.ChartData.Workbook.Worksheets(1)
        Set xlRange = xlSht.Range(sRange)
        
        '차트 소스 영역 수정
        Set xlNewRange = xlRange.Offset(xlRange.Rows.Count * (i - 1))
        'Debug.Print xlSht.Name & "!" & xlNewRange.Address
        cht.SetSourceData Source:=xlSht.Name & "!" & xlNewRange.Address
        
        '차트 제목수정
        cht.ChartTitle.Text = xlNewRange(1)
        
        '데이터라벨에 출력할 셀 Range 수정
        For j = 1 To cht.SeriesCollection.Count
            Set srs = cht.SeriesCollection(j)
            If srs.HasDataLabels Then
                'srs.ApplyDataLabels
                With srs.DataLabels
                    If .ShowRange Then
                        .Format.TextFrame2.TextRange.InsertChartField _
                            msoChartFieldRange, "=" & xlSht.Name & "!" & _
                                "$G$" & xlNewRange(1).Row + 1 & ":$G$" & xlNewRange.Row + 3
                        .ShowRange = True
                    End If
                    'Debug.Print "=" & xlSht.Name & "!" & _
                                "$G$" & xlNewRange(1).Row + 1 & ":$G$" & xlNewRange.Row + 3
                End With
            End If
        Next j
        'cht.Refresh
        'DoEvents
        xlSht.Parent.Close '엑셀 창 닫기
    Next i

End Sub

Sub test1()
    Debug.Print getSourceData(ActiveWindow.Selection.ShapeRange(1).Chart)
End Sub
Sub test2()
    With ActiveWindow.Selection.ShapeRange(1).Chart
        .ChartData.ActivateChartDataWindow
        .SetSourceData Source:="Sheet1!$B$10:$D$13"
        '.Refresh
    End With
End Sub
Sub test3()
    Dim DtLabel As DataLabel
    Dim srs As Series
    Dim cht As Chart
    Dim j%, k%
    Set cht = ActiveWindow.Selection.ShapeRange(1).Chart
    cht.ChartData.ActivateChartDataWindow
        For j = 1 To cht.SeriesCollection.Count
            Set srs = cht.SeriesCollection(j)
            If srs.HasDataLabels Then
                'srs.ApplyDataLabels
                For k = 1 To srs.DataLabels.Count   '//not working
                    Set DtLabel = srs.DataLabels(k)
                    If DtLabel.ShowRange Then
                         DtLabel.Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, "=Sheet1!G$11:$G$13", 0
                        'DtLabel.Format.TextFrame2.TextRange.InsertAfter ", "
                        DtLabel.ShowRange = True
                    End If
                    If DtLabel.ShowValue Then
                        DtLabel.ShowValue = True
                        'DtLabel.Format.TextFrame2.TextRange.InsertChartField msoChartFieldValue
                    End If
                    DtLabel.AutoText = True
                Next k
            End If
        Next j
    cht.ChartData.Workbook.Close
End Sub
Sub test4()
    Dim DtLabel As DataLabel
    Dim srs As Series
    Dim cht As Chart
    Dim j%, k%
    Set cht = ActiveWindow.Selection.ShapeRange(1).Chart
    cht.ChartData.ActivateChartDataWindow
        For j = 1 To cht.SeriesCollection.Count
            Set srs = cht.SeriesCollection(j)
            If srs.HasDataLabels Then
                With srs.DataLabels
                    If .ShowRange Then
                        .Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, "=Sheet1!G$7:$G$9", 0
                        .ShowRange = True
                    End If
                End With
 
            End If
        Next j
    cht.ChartData.Workbook.Close
End Sub
Function getSourceData(oCht As Chart) As String
    
    Dim sform1 As String, sform2 As String
    Dim srs1 As Series, srs2 As Series
    Dim r1 As Object, r2 As Object
    Dim oSht As Object
    
    'oCht.ChartData.ActivateChartDataWindow
    Set srs1 = oCht.SeriesCollection(1)
    Set srs2 = oCht.SeriesCollection(oCht.SeriesCollection.Count)
    sform1 = srs1.Formula
    sform2 = srs2.Formula
    Set oSht = oCht.ChartData.Workbook.Worksheets(1)
    Set r1 = oSht.Range(Split(sform1, ",")(1))(1)
    Set r2 = oSht.Range(Split(sform2, ",")(2)).Item(UBound(srs1.Values))
    getSourceData = r1.Offset(-1).Address & ":" & r2.Address
    'oSht.Parent.Close
End Function

 

여기서 사용된 차트는 별도의 엑셀 원본에 연결(Link)된 차트인데

파워포인트 파일에 포함된 차트의 경우도 작동할 겁니다.

 

엑셀 연동용 PPT 예시_LINK.pptm

0.05MB