Выберите и скопируйте контент в уникальной форме Powerpoint VBA

Question

Я хотел бы выбрать «Прямоугольник 132» на каждом слайде, скопировать содержимое в «меню контура» в качестве заголовка для слайда с помощью VBA.

В конечном итоге было бы неплохо найти «заголовок» "rubri c над фактическим слайдом, поэтому он не отображается на слайде.

Sub LoopThroughSlides()

'PURPOSE: Show how to loop through all slides in the active presentation

Dim sld As Slide
'Loop Through Each Slide in ActivePresentation
  For Each sld In ActivePresentation.Slides
    'Do something...(ie add a transition to slides)

      Function getShapeByName(shapeName As String, Slide As Integer)
    Set getShapeByName = ActivePresentation.Slides(Slide).Shapes(shapeName)
End Function

Dim myshape As Shape
myshape = getShapeByName("Rectangle 132", 1)

  Next sld

End Function

End Sub

•••• ˇˇˇˇ

Я нашел это, но не уверен, как его применить :

With ActivePresentation.Slides(1)

    If .Layout <> ppLayoutBlank Then

        With .Shapes

            If Not .HasTitle Then

                .AddTitle.TextFrame.TextRange.Text = "Restored title"

            End If

        End With

    End If

End With

Answer 1

Извините, но названия не работают таким образом. Заголовок заполнителя имеет специальный статус в программе, который нельзя перенести в другие фигуры. Если вы скопируете текст из Rectangle 132 и вставите его в заполнитель заголовка, он будет работать как положено.

В качестве иллюстрации особого характера заполнителя я создал слайд, используя Пробел макет, который не имеет названия. Я открыл Outline View, затем набрал текст рядом с миниатюрой слайда. Этот текст автоматически считается заголовком слайда, и PowerPoint создает местозаполнитель заголовка на пустом слайде, даже если у него его раньше не было.

Answer 2

Когда вы меняете свой вопрос, рассмотрите возможность создания новой темы, а не привязывайте ее к предыдущей. Попробуйте VBA:

Sub SetTitle()
    Dim sld As Slide, oShape As Shape, TitleText As String, TitlePHName As String

    For Each sld In ActivePresentation.Slides
        For Each oShape In sld.Shapes
            If oShape.Name = "Rectangle 132" Then
                If oShape.HasTextFrame Then
                    If oShape.TextFrame2.HasText Then
                        TitleText = oShape.TextFrame2.TextRange.Text
                    End If
                End If
            End If
            If Left(oShape.Name, 5) = "Title" Then
                TitlePHName = oShape.Name
            End If
        Next oShape
        If sld.Layout <> ppLayoutBlank Then
            If sld.Shapes.HasTitle Then
                sld.Shapes(TitlePHName).TextFrame2.TextRange.Text = TitleText
            Else
                sld.Shapes.AddTitle.TextFrame2.TextRange.Text = TitleText
            End If
        End If
        TitlePHName = ""
        TitleText = ""
    Next sld
End Sub