如何将 excel 数据粘贴到 powerpoint 中并仍然允许用户编辑数据

Question

我想知道是否有一种方法可以将 exporting/pasting 范围内的 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

可以，但是当运行一个大型 ppt 平台时，这个过程对我来说非常麻烦。这通过使用 ppt 形状位置作为粘贴位置来实现。使用模板ppt幻灯片进行测试，可以这样粘贴表格和图表。

    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

Answer 2

替换：

mySlide.Shapes.PasteSpecial DataType:=2

与：

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

希望这对您有所帮助， TheSilkCode

如何将 excel 数据粘贴到 powerpoint 中并仍然允许用户编辑数据

How to paste excel data into powerpoint and still allow the user to edit data

excel

powerpoint

vba