我需要将Excel中的大量数据(例如A1:B2000)粘贴到PowerPoint演示文稿中,每张幻灯片都有一张表格,其中包含来自excel的40行数据。我正在努力将范围最终粘贴到PowerPoint中的表中。
更详细地讲,我研究了两种可能的解决方案:A)将Excel数据作为新表粘贴到PowerPoint幻灯片中,然后重新格式化;或B),因为我认为这应该是更好的解决方案,请将Excel数据粘贴到PowerPoint中的现有表中。
我具有复制一个范围并在PowerPoint幻灯片中的表格中选择一个单元格的代码,我要将Excel单元格的范围粘贴到其中,但是我不知道如何完成最后一步,即粘贴Excel数据进入PowerPoint表。
Private Sub pptpaste2()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object
Dim myslide As Object
Dim myshape As Object
Dim pptLayout As CustomLayout
Dim ppTbl As Object
'code to insert excel rows into tables already existing in powerpoint presentation slides
Set r = ThisWorkbook.Worksheets("listdata").Range("B3:C11")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("RoughVBApres.ppxt")
Set pptLayout = mypresentation.Slides(3).CustomLayout
Set myslide = mypresentation.Slides(3)
powerpointapp.Visible = True
powerpointapp.Activate
If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
'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
'copy range in excel that you want to paste into table on powerpoint
r.Copy
'Make the presentation the active presentation
mypresentation.Windows(1).Activate
Application.CutCopyMode = False
' find on Slide Number 3 which object ID is of Table type
With powerpointapp.ActivePresentation.Slides(3).Shapes
For i = 1 To .Count
If .Item(i).HasTable Then
ShapeNum = i
End If
Next
End With
' assign Slide Table object
Set ppTbl = powerpointapp.ActivePresentation.Slides(3).Shapes(ShapeNum)
' select the Table cell you want to copy to
ppTbl.Table.Cell(1, 1).Shape.Select
我相信我已经完成了所有代码,最终将数据粘贴到PowerPoint幻灯片表中。 我尝试过
powerpointapp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
及其在网上其他地方建议的变体,但这似乎不起作用。如果可能的话,我想指导如何最终将复制的范围粘贴到PowerPoint中的现有表中。
谢谢。