将 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