![](/img/trans.png)
[英]How to copy the slides from existing presentation to new presentation based on the specific slide input?
[英]How to loop through slides in a presentation, pasting a new Excel range into a table in each slide
我试图使用vba将excel中大范围的每20行粘贴到powerpoint中,每隔20行在单独的幻灯片中的单独表格中粘贴。 我一直在努力解决这个问题,所以任何帮助都会非常感激。
我已经尝试遍历excel范围,我相信它有效,但我还没有设法将范围粘贴到单独的幻灯片中 - 目前它们多次粘贴到同一幻灯片中的同一个表中。
代码1:
循环遍历excel范围,但粘贴到一张幻灯片中的一个特定表中,而不是将每20行粘贴到单独的幻灯片中的单独表中:
Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object
Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")
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
'Make the presentation the active presentation
mypresentation.Windows(1).Activate
'copy range in excel to paste into table on powerpoint
Dim z As Integer
'here define the range to paste
For z = 1 To 150 Step 20
Range(r(z, 1), r(z + 19, 2)).Copy
' find the table on a specific slide
With powerpointapp.ActivePresentation.Slides(3).Shapes(2).Table
.Cell(1, 1).Select
'paste into the table
powerpointapp.CommandBars.ExecuteMso ("Paste")
End With
Next z
End Sub
代码2:
在这里,我试图循环演示文稿中的幻灯片,但我失败并得到错误代码:Shape(未知成员)无效请求。 要选择形状,其视图必须处于活动状态
Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object
Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")
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
'Make the presentation the active presentation
mypresentation.Windows(1).Activate
'copy range in excel to paste into table on powerpoint
Dim i As Integer
Dim z As Integer
'here define the range
For z = 1 To 150 Step 20
Range(r(z, 1), r(z + 19, 2)).Copy
'here loop through the slidse in the presentation, pasting into each slide
For i = 3 To powerpointapp.ActivePresentation.Slides.Count
With powerpointapp.ActivePresentation.Slides(i).Shapes(2).Table
'Paste the range into the table
.Cell(1, 1).Select
powerpointapp.CommandBars.ExecuteMso ("Paste")
End With
Next i
Next z
End Sub
如上所述,我希望或尝试将每20行粘贴到单独的幻灯片中的单独表中,但我尝试过的两种类型的代码都不起作用 - 1)第一个代码将循环的excel范围粘贴到同一个同一张幻灯片中的表和2)第二个代码有错误。
任何帮助将不胜感激。
我发现为PowerPoint表创建标记很有帮助,将标记名称设置为TABLENAME,将标记值设置为Excel表格的名称。 然后你可以循环搜索有问题的特定标签并更新该表,然后转到下一个。
我还建议将Excel数据放入Excel中的表中,然后在vba中引用它们。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.