Я пытаюсь вставить каждые 20 строк из большого диапазона в Excel в PowerPoint, каждые 20 строк в отдельной таблице на отдельном слайде, используя vba.Некоторое время я боролся с этим, поэтому любая помощь будет принята с благодарностью.
Я уже пытался перебрать диапазон 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) второй код содержит ошибку.
Любая помощь будет принята с благодарностью.