![](/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.