Replace fonts in grouped objects - Powerpoint 365

Question

I have been trying to develop a macro which will replace all fonts in presentation with "Arial". So far I have been successful in replacing fonts for textboxes, tables and SmartArt but couldn't able replace fonts in grouped objects. Below is the code for reference. Can anyone please help?

Sub TextFonts()

Dim oSl As Slide
Dim oSh As Shape
Dim oTbl As Table
Dim oSmt As SmartArt
Dim oNode As SmartArtNode

Dim lRow As Long
Dim lCol As Long
Dim sFontName As String

sFontName = "Arial"

With ActivePresentation
    For Each oSl In .Slides
        For Each oSh In oSl.Shapes
            With oSh
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = sFontName
                    End If
                End If
            End With
        Next
    Next
End With

For Each oSh In oSl.Shapes
    If oSh.HasTable Then
        Set oTbl = oSh.Table
        For lRow = 1 To oTbl.Rows.Count
            For lCol = 1 To oTbl.Columns.Count
                With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                    .Font.Name = "Arial"
                End With
            Next
        Next
    ElseIf oSh.HasSmartArt Then
        For Each oNode In oSh.SmartArt.AllNodes
            oNode.TextFrame2.TextRange.Font.Name = "Arial"
        Next
    End If
Next

Next oSl End Sub

score 0 · Answer 1 · answered Apr 19 '17 at 18:43

Assuming oshp is the grouped object ( you can easily loop through all the shapes and test whether it's a grouped shape or not If oshp.type = msoGroup then .... then you can access individual shapes by

 Dim li As Long
    Dim oshp As Shape

    Set oshp = powerpoint.shape

If oshp.type = msoGroup then

          For li = 1 To oshp.GroupItems.count
            ' you can add some code here for finding a particular shape based on certain properties 
             oshp.GroupItems(li).Select
             if oshp.type=rectangle etc etc
          Next

the code mentioned by you above remains the same. this is simply a vague explanation, but you will get it

score 0 · Answer 2 · edited May 29 '17 at 12:04

Code to replace entire presentation with selected single font:

Sub TextFonts()

 Dim oSl As Slide
 Dim oSh As Shape
 Dim oTbl As Table
 Dim oSmt As SmartArt
 Dim oNode As SmartArtNode

 Dim lRow As Long
 Dim lCol As Long
 Dim X As Long
 Dim sFontName As String

 sFontName = "Arial"


 'Text Boxes
 With ActivePresentation
     For Each oSl In .Slides
         For Each oSh In oSl.Shapes
             With oSh
                 If .HasTextFrame Then
                     If .TextFrame.HasText Then
                         .TextFrame.TextRange.Font.Name = sFontName
                     End If
                 End If
             End With
         Next
     Next
 End With

 'Grouped Objects
 For Each oSl In ActivePresentation.Slides
     For Each oSh In oSl.Shapes
         With oSh
             Select Case .Type
             Case Is = msoGroup
                 For X = 1 To .GroupItems.Count
                     If .GroupItems(X).HasTextFrame Then
                         If .GroupItems(X).TextFrame.HasText Then
                              .GroupItems(X).TextFrame.TextRange.Font.Name = sFontName
                         End If
                     End If
                 Next X
             End Select
         End With ' oSh
     Next oSh
 Next oSl

 'Smart Arts
 For Each oSl In ActivePresentation.Slides
     For Each oSh In oSl.Shapes
         If oSh.HasTable Then
             Set oTbl = oSh.Table
             For lRow = 1 To oTbl.Rows.Count
                 For lCol = 1 To oTbl.Columns.Count
                     With oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange
                         .Font.Name = sFontName
                     End With
                 Next
             Next
         ElseIf oSh.HasSmartArt Then
             For Each oNode In oSh.SmartArt.AllNodes
                 oNode.TextFrame2.TextRange.Font.Name = sFontName
             Next
         End If
     Next
 Next oSl

End Sub

Replace fonts in grouped objects - Powerpoint 365

2 Answers2