我的问题来自需要将所有文本字体更改为特定字体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 作为形状，字体作为字符串("子例程只是为了避免冗余。它只是检查给定shp是否具有除font以外的任何其他字体的文本并对其进行更改。在某个地方，Set_Font_Of_All_TextFrames Nothing "X"被称为。它按预期工作，但会出现以下问题：
1( 如何使此功能可用于更改字体以外的其他操作？我真的必须复制粘贴所有这些吗？
2(我是否可以像在我的函数中使用函数一样遍历所有形状和组，但它不是调用set_font子例程，而是使用对可以找到的所有形状的引用填充列表？这个列表我可以传递给例如set_font子程序(以及应该对所有形状执行操作的任何其他子程序(？
3( 为什么主控形状被排除在我的函数之外？
多亏了评论，我发现这或多或少是要走的路。我在这里发布我的"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