Добавление заголовков слайдов в Powerpoint из файла Excel - PullRequest
Новая
       25

Добавление заголовков слайдов в Powerpoint из файла Excel

0 голосов
/ 14 июня 2019

Я пытаюсь добавить заголовок слайда в ppt из файла Excel. Но я не могу поставить это в цикл. Каждая ячейка от A1 до A7 имеет заголовки слайдов в файле, и, соответственно, я хочу поместить заголовки в слайды в соответствии с номером слайда. Ниже приведен код, который я написал. 

For i = 1 To 7
With Application.Presentations(1)

    For Each ppSlide In .Slides()
       If ppSlide.Shapes.HasTitle Then ppSlide.Shapes.Title.TextFrame.TextRange = xlWorkSheet.Cells(i, 1)
    Next ppSlide

End With

Next i

1 Ответ

0 голосов
/ 14 июня 2019

Я предполагаю, что вы запускаете VBA-код в PowerPoint.

Вы можете установить заголовок слайда, только если вы нашли соответствующую форму, которая содержит заголовок.Эта форма может быть распознана по Shape.Type = msoPlaceholder и PlaceholderFormat.Type = ppPlaceholderTitle (или PlaceholderFormat.Type = ppPlaceholderCenterTitle).

Если вы хотите цикл от 1 до 7, то вы можете обращаться к слайдам по их индексу от 1 до 7 также(а не дополнительной For Each петлей над всеми слайдами). 

Private Sub SetTitlesFromExcellist()
    Dim xlApp As Excel.Application
    Dim xlWorkSheet As Excel.worksheet
    Dim ppSlide As PowerPoint.Slide
    Dim ppShape As PowerPoint.Shape
    Dim i As Long

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then Exit Sub
    Set xlWorkSheet = xlApp.ActiveSheet

    For i = 1 To 7
        Set ppSlide = ActivePresentation.Slides(i)
        If ppSlide.Shapes.HasTitle Then
            For Each ppShape In ppSlide.Shapes
                If ppShape.Type = msoPlaceholder Then
                    Select Case ppShape.PlaceholderFormat.Type
                    Case ppPlaceholderCenterTitle, ppPlaceholderTitle
                        ppShape.TextFrame.TextRange.Text = xlWorkSheet.Cells(i, 1)
                        Exit For
                    End Select
                End If
            Next ppShape
        End If
    Next i
End Sub
...