슬라이드의 테이블(표)과 차트의 데이터 연동시키기

원래 슬라이드의 테이블(표)의 데이터는 슬라이드에 삽입된 차트의 데이터와 전혀 무관합니다.

차트 수치를 변경하려면 어떻게 해서든 차트의 엑셀 데이터를 수정해야 합니다.

 

이렇게 테이블의 표내용을 차트에 반영 즉 차트 엑셀 데이터에 붙여넣고 싶을 대 사용할 수 있는 매크로입니다.

UpdataChart 매크로를 실행하면 테이블(표)의 데이타를 복사해서
차트의 엑셀시트에 붙여 넣습니다. 엑셀 데이터가 변경되면 차트 모양도 변경됩니다. 
Alt-F8누르고 UpdateChart 실행하세요. 

업데이트 후 저장하는 것이 좋습니다. 저장하지 않으면 원래대로 돌아가는 경우가 종종 있습니다.

반드시 차트와 테이블은 각각 이름이 Chart 1과 Table 1 이어야 합니다.
Alt-F10 누르고 선택해서 더블클릭하거나 F2키로 이름은 변경 가능합니다.

 

'Update the Chart using the table data
Sub UpdateChart()

    'Dim xl As New Excel.Application
    'Dim wb As Excel.Workbook
    Dim sht As Excel.Worksheet
        
    Dim pres As Presentation
    Dim sld As Slide
    Dim tshp As Shape, cshp As Shape
    Dim tbl As Table
    
    Set pres = ActivePresentation
    Set sld = ActiveWindow.Selection.SlideRange(1)
    Set tshp = sld.Shapes("Table 1")
    tshp.Copy   '파워포인트 표 복사
    
    Set cshp = sld.Shapes("Chart 1")
    With cshp.Chart.ChartData
        '.ActivateChartDataWindow
        'wait for the Excel window
        'Set xl = .Workbook.Application
        'While .Workbook.Application.WindowState <> -4143    '-4143=xlNormal
        '    .Workbook.Application.Wait Now() + TimeValue("00:00:01")
        '    DoEvents
        'Wend
    
        Set sht = .Workbook.Worksheets(1) '첫번째 시트
        sht.Paste sht.Range("A1") '차트 데이터 시트에 붙여넣기
        '.Workbook.Application.CommandBars.ExecuteMso ("Paste")
    End With
    
    'xl.Quit
    'Set xl = Nothing
    If MsgBox("Table1 표를 Chart1 데이터에 반영 완료! " & vbNewLine & vbNewLine & _
        "적용된 데이터가 유실될 수 있으니 저장하는 것이 좋습니다" & vbNewLine & _
        "현재 파일을 저장할까요?", vbOKCancel) _
        = vbOK Then pres.Save
    
End Sub

 

 

반대로 차트의 데이터 내용을 슬라이드의 테이블(표)에 반영하고 싶을 때는

UpdateTable 매크로를 이용하면 됩니다.

'Update the table data using the data in a chart
Sub UpdatTable()
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim rng As Excel.Range
    
    Dim pres As Presentation
    Dim sld As Slide
    Dim tshp As Shape, cshp As Shape
    Dim tbl As Table
    Dim r As Integer, c As Integer
    
    If MsgBox("현재파일을 저장하고" & vbNewLine & _
        "Chart1의 엑셀데이터를 Table1에 복사하시겠습니까?", vbOKCancel) _
        <> vbOK Then Exit Sub
  
    Set pres = ActivePresentation
    pres.Save
    Set sld = ActiveWindow.Selection.SlideRange(1)
    Set tshp = sld.Shapes("Table 1")
    Set tbl = tshp.Table
        
    Set cshp = sld.Shapes("Chart 1")
    'cshp.Select
    'cshp.Chart.Refresh
    Set wb = cshp.Chart.ChartData.Workbook
    'wb.RefreshAll
    Set xl = wb.Application
    'wb.Close
    
    xl.Calculate
    'xl.Calculation = -4105    '  xlCalculationAutomatic
    'xl.ScreenUpdating = True
    
    'wb.SaveLinkValues = True
    'wb.Saved = True
    With cshp.Chart.ChartData
        '.ActivateChartDataWindow
        'wait for the Excel window
        'Set xl = .Workbook.Application
        'While .Workbook.Application.WindowState <> -4143    '-4143=xlNormal
        '    .Workbook.Application.Wait Now() + TimeValue("00:00:01")
        '    DoEvents
        'Wend
    
        Set sht = .Workbook.Worksheets(1) '첫번째 시트
    End With
    
    For r = 1 To tbl.Rows.Count
        For c = 1 To tbl.Columns.Count
            tbl.Cell(r, c).Shape.TextFrame.TextRange = sht.Cells(r, c)
        Next c
    Next r
        
    'cshp.Chart.ChartData.Workbook.Close '//This should not be closed!
    wb.Close
    xl.Quit
    Set xl = Nothing
    
End Sub

 

지식인 링크(실행영상 있음):

kin.naver.com/qna/detail.nhn?d1id=1&dirId=102&docId=362023594&qb=dXBkYXRlY2hhcnQ=&enc=utf8&section=kin.qna&rank=2&search_sort=0&spq=0

파워포인트 차트에 관해서요

 

아래는 테스트 파일입니다.

UpdateChart2-.pptm

0.05MB