Как перебирать слайды в презентации, вставляя новый диапазон Excel в таблицу на каждом слайде - PullRequest
0 голосов
/ 15 мая 2019

Я пытаюсь вставить каждые 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) второй код содержит ошибку.

Любая помощь будет принята с благодарностью.

1 Ответ

0 голосов
/ 20 мая 2019

Я считаю полезным создавать теги для таблиц PowerPoint, в которых для имени тега задается значение TABLENAME, а для значения тега - имя таблицы Excel.Затем вы можете выполнить цикл для конкретного рассматриваемого тега и обновить эту таблицу, а затем перейти к следующей.

Я также рекомендую помещать ваши данные Excel в таблицы в Excel и затем ссылаться на них в vba.

...