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

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

1 个答案: