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

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

我查了一下Google，发现有人build议使用.Breaklink方法：只要在我的工作表上没有多于一个图表，我们就可以使用.Breaklink方法。 如果至less有两个graphics，它将正确复制第一个graphics，然后在第二个graphics上工作时抛出“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设置参考，并且至less应在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