将单元格范围从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

您必须明确引用幻灯片。我也会明确参考演示文稿。 幻灯片（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