如何将Excel数据粘贴到PowerPoint中，并仍然允许用户编辑数据

我想知道是否有一种方法将excel范围导出/粘贴到PowerPoint中，同时仍然允许用户编辑结果。 我在互联网上看到的代码将excel中的数据粘贴到powerpoint中作为图片。 下面是一个例子：

Sub export_to_ppt(ByVal sheetname As String, ByVal initialSelection As String) ', ByVal cols As Integer, ByVal rows As Integer) Application.ScreenUpdating = False Dim rng As Range Dim PowerPointApp As Object Dim myPresentation As Object Dim mySlide As Object Dim myShape As Object 'Copy Range from Excel 'Set rng = ThisWorkbook.ActiveSheet.Range("B17:D50") 'Create an Instance of PowerPoint On Error Resume Next 'Is PowerPoint already opened? Set PowerPointApp = GetObject(class:="PowerPoint.Application") 'Clear the error between errors Err.Clear 'If PowerPoint is not already open then open PowerPoint If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application") 'Handle if the PowerPoint Application is not found If Err.Number = 429 Then MsgBox "PowerPoint could not be found, aborting." Exit Sub End If On Error GoTo 0 'Optimize Code Application.ScreenUpdating = False 'Create a New Presentation Set myPresentation = PowerPointApp.Presentations.Add 'Add a slide to the Presentation Set mySlide = myPresentation.Slides.Add(1, 12) '12 = ppLayoutBlank 'Copy Excel Range Dim rowCount As Integer Dim colcount As Integer Dim i As Integer Dim No_sheets As Integer No_sheets = Worksheets("Control_Sheet").Range("AP2").Value + 2 For i = 3 To No_sheets Worksheets("Control_Sheet").Activate Worksheets("Control_Sheet").Cells(i, 42).Select If Worksheets("Control_Sheet").Cells(i, 42).Value = sheetname Then rowCount = Worksheets("Control_Sheet").Cells(i, 44).Value colcount = Worksheets("Control_Sheet").Cells(i, 43).Value GoTo resume_copy End If Next i resume_copy: Worksheets(sheetname).Activate Worksheets(sheetname).Range(initialSelection).Select Selection.Resize(rowCount, colcount).Select Selection.Copy 'Paste to PowerPoint and position Application.Wait Now + TimeValue("00:00:01") mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile Set myShape = mySlide.Shapes(mySlide.Shapes.Count) 'Set position: myShape.Left = 1 myShape.Top = 1 myShape.Width = 950 PowerPointApp.Visible = True PowerPointApp.Activate Application.CutCopyMode = False Application.ScreenUpdating = True End Sub 

Answer 1

更换：

 mySlide.Shapes.PasteSpecial DataType:=2 

附：

 mySlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, DisplayAsIcon:=msoFalse, link:=msoFalse 

希望这有助于TheSilkCode

Answer 2

你可以，但是这个过程在运行一个大型的ppt套牌时对我来说是非常麻烦的。 这通过使用ppt形状位置作为粘贴的位置来工作。 使用一个模板PPT幻灯片来testing，你可以这样粘贴表格和graphics。

  Dim myApp As PowerPoint.Application Dim myPres As PowerPoint.Presentation Dim myStatsSlide As PowerPoint.Slide Set myApp = New PowerPoint.Application Set myPres = myApp.ActivePresentation Set myStatsSlide = myPres.Slides(1) Dim mySheet As Worksheet Set mySheet = ActiveSheet 'Copy table as table, not image Dim mySumTable As Range Set mySumTable = mySheet.Range("A1:C5") mySumTable.Copy myStatsSlide.Shapes.Placeholders(1).Select myPres.Windows(1).View.Paste 'Copy Chart, as chart not image Dim monoChart As ChartObject 'MONO CHART monoChart.Select ActiveChart.ChartArea.Copy Debug.Print monoChart.Name myStatsSlide.Shapes.Placeholders(2).Select myPres.Windows(1).View.Paste Debug.Print monoChart.Name