연결된 차트의 시트변경시 연결 자동 복구

관련: 지식인

 

엑셀에서 만든 차트를 복사해서

파워포인트 슬라이드에 연결로 붙여넣고 사용하다가

파워포인트에서 차트 데이터를 변경하면 원본을 변경저장할 지 확인하고

저장을 선택하면 잘 업데이트가 됩니다.

 

하지만 따로 엑셀로 원본 엑셀파일을 열어서 시트이름을 변경하고 저장한다면

파워포인트 파일에서는 이런 변경사실을 알지 못해서 

다시 데이터를 편집하려고 하면 차트의 내용이 나오지 않게 됩니다.

 

이 때 원본 차트의 시트이름을 복구하는 코드입니다.

 

Option Explicit

Sub reLinkChartData()

    Dim shp As Shape
    Dim srs As Series
    Dim srscol As SeriesCollection
    Dim Sheet1Name As String
    Dim sData As String
    '현재 차트
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    With shp.Chart
        
        .ChartData.Activate
        Sheet1Name = .ChartData.Workbook.Worksheets(1).Name
        
        sData = getSourceDataString(shp.Chart, False)
        Debug.Print sData
        
        sData = "'" & Sheet1Name & "'" & Mid(sData, InStr(sData, "!"))
        Debug.Print sData
        
        .SetSourceData sData
        .ChartData.Workbook.Close
        
    End With
End Sub

Function getSourceDataString(oCht As Chart, Optional OpenDataWindow As Boolean = True) As String
    
    Dim sform1 As String, sform2 As String
    Dim srs1 As Series, srs2 As Series
    Dim r1 As String, r2 As String
    Dim oSht As Object
    Dim r As Excel.Range
    
    
    '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    If OpenDataWindow Then oCht.ChartData.Activate  'ChartDataWindow
    Set srs1 = oCht.SeriesCollection(1)
    Set srs2 = oCht.SeriesCollection(oCht.SeriesCollection.Count)
    sform1 = srs1.Formula: '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    sform2 = srs2.Formula: '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    
    Set oSht = oCht.ChartData.Workbook.Worksheets(1)
    r1 = Split(sform1, ",")(1): r1 = Split(r1, ":")(0)
    'If InStr(r1, "]") > 0 Then r1 = "'" & Mid(r1, InStr(r1, "]") + 1)
    r2 = Split(sform2, ",")(2): r2 = Split(r2, ":")(1)
    getSourceDataString = r1 & ":" & r2
    If OpenDataWindow Then oSht.Parent.Close
    
End Function

Function getSourceData(oCht As Chart, Optional OpenDataWindow As Boolean = True) 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
    Dim r As Excel.Range
    
    
    '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    If OpenDataWindow Then oCht.ChartData.Activate  'ChartDataWindow
    Set srs1 = oCht.SeriesCollection(1)
    Set srs2 = oCht.SeriesCollection(oCht.SeriesCollection.Count)
    sform1 = srs1.Formula: '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    sform2 = srs2.Formula: '=SERIES(,'Sheet 4'!$A$1:$A$10,'Sheet 4'!$B$1:$B$10,1)
    
    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.Address & ":" & r2.Address
    If OpenDataWindow Then oSht.Parent.Close
    
End Function

Function getFullAddress(r As Object)

    getFullAddress = "'" & r.Parent.Name & "'!" & r.Address(External:=False)

End Function

 

getSourceDataString 이라는 함수를 만들었는데

원본 차트의 차트영역의 Fromula 를 구해서 

Sheet 이름을 현재 Workbook 의 첫번째 시트이름으로 다시 변경해서

SetSourceData로 변경된 영역을 적용해 줍니다.

 

실행영상으로 확인하세요.

 

샘플파일 첨부합니다.

 

ReLinkChart1.zip

0.05MB