将Excel图表复制/粘贴到PowerPoint并断开链接

Question

我想使用VBA（Excel和PowerPoint 2013）将几个图表复制到PowerPoint。只要我不试图破坏Excel和PowerPoint之间的图形连接，我的宏就可以正常工作 - 我绝对需要这样做。

我在Google上查找过，发现有人建议使用.Breaklink方法：只要在我的工作表上没有多于一个图表，它工作得非常好，实际上会中断链接。如果至少有两个图形，它将正确复制第一个图形，然后在第二个图形上工作时抛出“MS PowerPoint已停止工作”消息。

我该如何继续？

我试图在.Chart.ChartData和.Shape对象上应用.BreakLink方法无济于事。

Sub WhyIsThisWrong() 
    Application.ScreenUpdating = False 
    Dim aPPT As PowerPoint.Application 
    Dim oSld As PowerPoint.Slide 
    Dim oShp As PowerPoint.Shape 
    Dim oCh As ChartObject 

     Set aPPT = New PowerPoint.Application 
     aPPT.Presentations.Add 
     aPPT.Visible = True 

     For Each oCh In ActiveSheet.ChartObjects 
     oCh.Activate 
     ActiveChart.ChartArea.Copy 

     aPPT.ActivePresentation.Slides.Add aPPT.ActivePresentation.Slides.Count + 1, ppLayoutText 
     Set oSld = aPPT.ActivePresentation.Slides(aPPT.ActivePresentation.Slides.Count) 

     oSld.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select 

     'Something is wrong here 
     With oSld.Shapes(3) 
      If .Chart.ChartData.IsLinked Then 
      '.Chart.ChartData.BreakLink 
      .LinkFormat.BreakLink 
      End If 
     End With 

     Next oCh 

    Set oSld = Nothing 
    Set aPPT = Nothing 
    Application.ScreenUpdating = True 
    End Sub 

Answer 1

这可能不是您确切的答案 - 它将图表作为图片粘贴到Powerpoint中。
注：没有提及需要设置为PP，并应工作在至少XL & PP 2007，2010 & 2013年

我已经更新了代码，具有两个粘贴为图片粘贴的图表，断开链接。希望它不是那种在我的机器上工作的情况之一..

Public Sub UpdatePowerPoint() 

    Dim oPPT As Object 
    Dim oPresentation As Object 
    Dim cht As Chart 

    Set oPPT = CreatePPT 
    Set oPresentation = oPPT.presentations.Open(_ 
     "<Full Path to your presentation>") 

    oPPT.ActiveWindow.viewtype = 1 '1 = ppViewSlide 

    ''''''''''''''''''''''''' 
    'Copy Chart to Slide 2. ' 
    ''''''''''''''''''''''''' 
    oPresentation.Windows(1).View.goToSlide 2 
    With oPresentation.Slides(2) 
     .Select 
     Set cht = ThisWorkbook.Worksheets("MySheetWithAChart").ChartObjects("MyChart").Chart 

     '''''''''''''''''''''''''' 
     'Paste Chart as picture. ' 
     '''''''''''''''''''''''''' 
'  cht.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen 
'  .Shapes.Paste.Select 

     ''''''''''''''''''''''''''''''''' 
     'Paste as Chart and break link. ' 
     ''''''''''''''''''''''''''''''''' 
     cht.ChartArea.Copy 
     .Shapes.Paste.Select 
     With .Shapes("MyChart") 
      .LinkFormat.BreakLink 
     End With 

     oPresentation.Windows(1).Selection.ShapeRange.Left = 150 
     oPresentation.Windows(1).Selection.ShapeRange.Top = 90 
    End With 

End Sub 

    '---------------------------------------------------------------------------------- 
    ' Procedure : CreatePPT 
    ' Date  : 02/10/2014 
    ' Purpose : Creates an instance of Powerpoint and passes the reference back. 
    '----------------------------------------------------------------------------------- 
    Public Function CreatePPT(Optional bVisible As Boolean = True) As Object 

     Dim oTmpPPT As Object 

     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     'Defer error trapping in case PowerPoint is not running. ' 
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     On Error Resume Next 
     Set oTmpPPT = GetObject(, "PowerPoint.Application") 

     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     'If an error occurs then create an instance of PowerPoint. ' 
     'Reinstate error handling.         ' 
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
     If Err.Number <> 0 Then 
      Err.Clear 
      On Error GoTo ERROR_HANDLER 
      Set oTmpPPT = CreateObject("PowerPoint.Application") 
     End If 

     oTmpPPT.Visible = bVisible 
     Set CreatePPT = oTmpPPT 

     On Error GoTo 0 
     Exit Function 

    ERROR_HANDLER: 
     Select Case Err.Number 

      Case Else 
       MsgBox "Error " & Err.Number & vbCr & _ 
        " (" & Err.Description & ") in procedure CreatePPT." 
       Err.Clear 
     End Select 

    End Function