Copy/paste Excel 图表到 PowerPoint 并断开链接

Question

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

我查看了 Google 并发现有人建议使用 .Breaklink 方法：它非常有效并且实际上会断开链接，只要我的 sheet。如果至少有两个图，它将正确复制第一个图，然后在处理第二个图时抛出 "MS PowerPoint has stopped working" 消息。

我该如何进行？

我尝试在 .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

Copy/paste Excel 图表到 PowerPoint 并断开链接

Copy/paste Excel charts to PowerPoint and break links

excel

powerpoint

vba