Получить * все * фигуры (включая вложенные группы) в активной презентации

Question

Мой вопрос связан с необходимостью изменить все текстовые шрифты на определенный c шрифт A. Я знаю, что в PowerPoint есть опция «Изменить шрифт ...», но она заставляет меня выбирать «из шрифта» "и" к шрифту ". В моем случае есть несколько разных шрифтов, которые следует заменить на шрифт «X». Таким образом, я написал следующий макрос VBA.

Private Sub Set_Font_Of_All_TextFrames(oShp As Shape, font As String)
' Go through all shapes on all slides. This is a recurisve function. First call needs to pass "Nothing" to oShp.
' Any font in every textframe that is not "font" will be set to "font".
' The recursion is necessary in order to go through groups.
' BUG/TODO: Text in Master is not included so far!

    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    If oShp Is Nothing Then ' first subroutine call
        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                If shp.Type = msoGroup Then
                    Set_Font_Of_All_TextFrames shp, font ' recursive call in case of group
                Else
                    Set_Font shp, font ' else change font
                End If
            Next shp
        Next sld
    ' in case of recursive calls:
    ElseIf oShp.Type = msoGroup Then
        For i = 1 To oShp.GroupItems.Count()
            Set shp = oShp.GroupItems.Item(i)
            Set_Font_Of_All_TextFrames shp, font ' another recursive call in case of group; will repeat this branch in case of subgroup
        Next
    Else
        Set shp = oShp
        Set_Font shp, font   ' else change font
    End If
End Sub

Подпрограмма Set_Font (shp as Shape, font as String) предназначена только для того, чтобы избежать избыточности. Он просто проверяет, есть ли в данном shp текст с любым другим шрифтом, кроме font, и изменяет его. Где-то называется Set_Font_Of_All_TextFrames Nothing "X". Это работает, как ожидалось, но возникают следующие вопросы:

1) Как сделать эту функцию доступной для других операций, кроме изменения шрифтов? Неужели мне действительно нужно копировать и вставлять все это?

2) Могу ли я использовать функцию для обхода всех фигур и групп, как в моей функции, но вместо вызова подпрограммы set_font она заполняет список ссылки на все формы, которые он может найти? Этот список я могу передать, например, подпрограмме set_font (и любой другой, которая должна выполнять действие со всеми фигурами)?

3) Почему фигуры на мастере исключены из моей функции?

Answer 1

Благодаря комментариям я обнаружил, что это более или менее путь к go. Я публикую здесь свою "функцию ulitity" для создания коллекции всех форм (включая все формы в произвольно вложенных подгруппах), которые можно использовать и повторять в любой другой функции или подпрограмме.

Простая версия, которая проходит через все слайды в активной презентации (они также ясно показывают, как функция должна работать):

Function Get_All_Shapes(oShp As Shape, oColl As Collection)
' Go through all shapes on all slides. This is a recursive function. First call needs to pass "Nothing" to oShp and oColl.
' The collection oColl will be populated with all shapes (including all shapes in all groups) in the presentation.
' The return parameter will be the gradually populated collection.
' The recursion is necessary in order to go through groups.

    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    If oShp Is Nothing And oColl Is Nothing Then ' first function call
        Set oColl = New Collection
        For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                If shp.Type = msoGroup Then
                    Set oColl = Get_All_Shapes(shp, oColl)  ' recursive call in case of group
                Else
                    oColl.Add shp ' else add shape to collection
                End If
            Next shp
        Next sld
    ' in case of recursive calls:
    ElseIf oShp.Type = msoGroup Then
        For i = 1 To oShp.GroupItems.Count()
            Set shp = oShp.GroupItems.Item(i)
            Set oColl = Get_All_Shapes(shp, oColl) ' another recursive call in case of group; will repeat this branch in case of subgroup
        Next
    Else
        oColl.Add oShp ' else add shape to collection
    End If
    Set Get_All_Shapes = oColl ' set populated collection as function return parameter
End Function

Вот более усовершенствованная версия, которая позволяет вам выбирать, заполнять ли коллекцию только выбранными фигурами (и вложенными подгруппы) и если мастер-слайд с его настраиваемыми макетами должен быть включен в коллекцию:

Function Get_All_Shapes_WIP(oShp As Shape, oColl As Collection, Optional onlySelected As Boolean = False, Optional includeMaster As Boolean = False)
' Go through all shapes on all slides. This is a recursive function. First call needs to pass "Nothing" to oShp and oColl.
' The collection oColl will be populated with all shapes (including all shapes in all groups) in the presentation.
' The return parameter will be the gradually populated collection.
' The recursion is necessary in order to go through groups.
' If onlySelected is True, only the selected shapes will be added to the collection.
' If includeMaster is True, shapes on the master slide and all custom layouts will be added to the collection. This behavior is not affected by the value of onlySelected.

    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    ' first function call (main loops)
    If oShp Is Nothing And oColl Is Nothing Then
        Set oColl = New Collection

        ' presentation loops
        If onlySelected = False Then ' all shapes on all slides
            For Each sld In ActivePresentation.Slides
                For Each shp In sld.Shapes
                    If shp.Type = msoGroup Then
                        Set oColl = Get_All_Shapes_WIP(shp, oColl, onlySelected, includeMaster) ' recursive call in case of group
                    Else
                        oColl.Add shp ' else add shape to collection
                    End If
                Next shp
            Next sld

        Else ' onlySelected = True
            For Each shp In ActiveWindow.selection.ShapeRange
                If shp.Type = msoGroup Then
                    Set oColl = Get_All_Shapes_WIP(shp, oColl, onlySelected, includeMaster) ' recursive call in case of group
                Else
                    oColl.Add shp ' else add shape to collection
                End If
            Next shp
        End If

        ' master loops
        If includeMaster = True Then ' add also slide master shapes to the collection
            ' master shapes
            For Each shp In ActivePresentation.SlideMaster.Shapes
                If shp.Type = msoGroup Then
                    Set oColl = Get_All_Shapes_WIP(shp, oColl, onlySelected, includeMaster) ' recursive call in case of group
                Else
                    oColl.Add shp ' else add shape to collection
                End If
            Next shp
            ' custom layouts shapes
            For i = 1 To ActivePresentation.SlideMaster.CustomLayouts.Count()
                For Each shp In ActivePresentation.SlideMaster.CustomLayouts.Item(i).Shapes
                If shp.Type = msoGroup Then
                    Set oColl = Get_All_Shapes_WIP(shp, oColl, onlySelected, includeMaster) ' recursive call in case of group
                Else
                    oColl.Add shp ' else add shape to collection
                End If
                Next shp
            Next
        End If

    ' recursive calls:
    ElseIf oShp.Type = msoGroup Then
        For i = 1 To oShp.GroupItems.Count()
            Set shp = oShp.GroupItems.Item(i)
            Set oColl = Get_All_Shapes_WIP(shp, oColl, onlySelected, includeMaster) ' another recursive call in case of group; will repeat this branch in case of subgroup
        Next
    Else
        oColl.Add oShp ' else add shape to collection
    End If

    Set Get_All_Shapes_WIP = oColl ' set (partially) populated collection as function return parameter in every call
End Function

Пример использования:

Sub Set_All_Fonts_To_Calibri()
' Sets the font of all text in all shapes in the presentation to "Calibri".

    Dim coll As Collection: Set coll = Get_All_Shapes_WIP(Nothing, Nothing, onlySelected:=False, includeMaster:=True)
    Dim shp As Shape

    For Each shp In coll
        Set_Font shp, "Calibri"
    Next shp
End Sub