近期工作经常需要汇总n多ppt文件，总的加起来超过六百多页。由于茫茫多的ppt是由好几个同事分别完成的，其中的格式字体都有出入，要做统一修改相当麻烦。
    为了提高效率，在网上疯狂搜寻解决之道。我发现网上现有的宏文件只能简单的修改文本框里的字体，对于复杂的组合对象和表格是无能为力的。因此，经过1小时的研究，改写了一下百度知道上的版本，试用下来还不错，在此放到网上，供大伙参考，相应的扩展功能可以依葫芦画瓢。

VBA：

Sub all_font()
 
    Dim oSl As Slide
    Dim oSh As Shape
    Dim sFontName As String
    Dim Ctr As Integer
    Dim Cl As Cell
   
    ' 这里可以设定需要统一的字体:
    sFontName = "华文细黑"

    With ActivePresentation
        For Each oSl In .Slides
            For Each oSh In oSl.Shapes
                With oSh
                    Select Case .Type
                        ' 判断组合对象部分
                        Case msoGroup                            
                            For Ctr = 1 To .GroupItems.Count
                                If .GroupItems(Ctr).HasTextFrame Then
                                .GroupItems(Ctr).TextFrame.TextRange.Font.Name = sFontName
                                .GroupItems(Ctr).TextFrame.TextRange.Font.NameFarEast = sFontName
                                .GroupItems(Ctr).TextFrame.TextRange.Font.NameOther = sFontName
                          
                                End If
                             Next Ctr
                        ' 判断表格对象部分 ，九号罗尼   
                        Case msoTable                            
                                For Ctr = 1 To .Table.Rows.Count
                                     For Each Cl In .Table.Rows(Ctr).Cells
                                     Cl.Shape.TextFrame.TextRange.Font.Name = sFontName
                                     Cl.Shape.TextFrame.TextRange.Font.NameFarEast = sFontName
                                     Cl.Shape.TextFrame.TextRange.Font.NameOther = sFontName
                                      Next Cl
                                  Next Ctr
                        ' 判断其他对象（文本框）部分   
                        Case Else
                            If .HasTextFrame Then
                                 If .TextFrame.HasText Then
                                    .TextFrame.TextRange.Font.Name = sFontName
                                    .TextFrame.TextRange.Font.NameFarEast = sFontName
                                    .TextFrame.TextRange.Font.NameOther = sFontName
                                 End If
                             End If
                     End Select
                End With
            Next
        Next
    End With
End Sub