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中 NB：不需要将参考设置为PP，并且至少应该使用XL＆amp; PP 2007,2010＆amp; 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

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

1 个答案: