将单元格范围从 Excel 粘贴到 Powerpoint

Question

我有一张演示幻灯片，它已经包含了它的内容。我现在的目标是将 Excel 中的新内容粘贴到同一张幻灯片上，而不是将新幻灯片添加到 PowerPoint 文件中。我使用的语言是 VBA。

这是我的代码：

Sub CreatePowerPoint()
'-------------------------------------------
'ADD A REFERENCE TO THE MICROSOFT POWERPOINT LIBRARY BY:
     '1. Go to Tools in the VBA menu
     '2. Click on Reference
     '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
'-------------------------------------------
'FIRST WE DECLARE THE VARIABLES WE WILL BE USING
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    'Dim tbl As ListObject
    Dim rng As Range, row As Long
    Dim sht As Worksheet
    row = 1
'-------------------------------------------
'LOOK FOR EXISTING INSTANCE
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
'-------------------------------------------
'LET'S CREATE A NEW POWERPOINT
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'-------------------------------------------
'MAKE A PRESENTATION IN POWERPOINT
    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If
'-------------------------------------------
'SHOW THE POWERPOINT
    newPowerPoint.Visible = True
'-------------------------------------------
'LOOP THROUGH EACH RANGE DATA SET IN THE EXCEL WORKBOOK AND PASTE THEM INTO THE POWERPOINT
    For Each sht In ThisWorkbook.Worksheets
         'For Each tbl In sht.ListObjects
         LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
         Do Until row >= LastRow
            For I = row To LastRow
                If Cells(I, 1) = "|" Then
                    LastCol = ActiveSheet.Cells(row, Application.Columns.Count).End(xlToLeft).Column
                    Set rng = Range(Cells(row, 1), Cells(I - 1, LastCol))

'Note: xlUp, xlToLeft = Returns a Range object that represents the cell at the end of the region that contains the source range.
'Equivalent to pressing END+UP ARROW, END+DOWN ARROW, END+LEFT ARROW, or END+RIGHT ARROW. Read-only Range object.
'-------------------------------------------
'ADD A NEW SLIDE WHERE WE WILL PASTE THE TABLE
                    newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
                    newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
                    Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'Note: ppLayoutText = the layout of the slide
'-------------------------------------------
'COPY THE TABLE AND PASTE IT INTO THE POWERPOINT AS DEFAULT (EDITABLE FORM IN PPT)
                    'tbl.Range.Copy
                    rng.Copy
                    activeSlide.Shapes.PasteSpecial(DataType:=ppPasteDefault).Select
'Note:ppPasteEnhancedMetafile/ppPasteOLEObject = if want to edit in Excel form
'-------------------------------------------
'ADJUST THE POSITIONING OF THE TABLE ON POWERPOINT SLIDE
                    With newPowerPoint.ActiveWindow.Selection.ShapeRange
                        .Left = 20
                        .Top = 125
                        .Width = 675
                    End With
                    activeSlide.Shapes(2).Width = 200
                    activeSlide.Shapes(2).Left = 505
                    row = I
                    Exit For
                End If
         'Next tbl
            Next I
            row = row + 1
        Loop

    Next sht
'-------------------------------------------
'CLEANUP
     Set activeSlide = Nothing
     Set newPowerPoint = Nothing
 End Sub

我不想添加新幻灯片，而是将其粘贴到已包含一些内容的活动 PowerPoint 幻灯片中。有人可以帮助我吗？提前致谢。

Answer 1

您必须明确引用幻灯片。我也会明确引用演示文稿。 slides(1) 引用的是第 1 张幻灯片。

'COPY THE TABLE AND PASTE IT INTO THE POWERPOINT AS DEFAULT (EDITABLE FORM IN PPT)
                    'tbl.Range.Copy
                    rng.Copy
                    Presentation ("PPT file name.pptx").Slides(1).Shapes.PasteSpecial(DataType:=ppPasteDefault).Select