Setting same font type to whole presentation using VBA

Question

I would like to set font type (calibri)of text( where ever there is an alphabet in presentation, it should be "calibri") in every slide by running the single macro using VBA. The problem is, it is unable to change the font present in 'chart', 'flow chart diagram' where it has boxes like rectangle, round cornered rectangles etc.How to manipulate that text as well? Please help!

As shown in the image the font of climate in rectangle is not changing.Different font type in rectangle

Answer 1

The solution to this problem is pretty tedious as there are so many different types of shapes and textranges to account for. I can't post my entire solution as I don't own the intellectual property, but this should get you on the right track:

Sub MakeFontsThemeFonts()

    Dim oSld As Slide
    Dim oShp As Shape
    Dim oShp2 As Shape
    Dim oTxtRange As TextRange

    ' Set majorFont and minorFont to Calibri
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Calibri"
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Calibri"        

    For Each oSld in ActivePresentation.Slides
        For Each oShp in oSld.Shapes
           If oShp.HasChart Then
               ' Call your chart handler
           ElseIf oShp.HasTable Then
               ' Call your table handler
           ElseIf oShp.HasSmartArt Then
               ' Call your SmartArt handler
           ElseIf oShp.HasTextFrame Then
               If oShp.HasText Then
                   Set oTxtRange = oShp.TextFrame.TextRange
                   Call RefontTextRange (oTxtRange)
               End If
           ElseIf oShp.Type = msoGroup Then
               For Each oShp2 in oShp.GroupItems
                    If oShp2.Type = ... Then
                         ' And so on, you wind up having to check for 
                         ' everything that's grouped all over again
                    End If
               Next
           End If
       Next
    Next
End Sub

Sub RefontTextRange (oTxtRange As TextRange)
   With oTxtRange.Font
       ' Sets the textrange to the body font.  If you want to make some stuff the heading font and some stuff the body font, you need to do more checking before sending here
       .Name = "+mn-lt"
   End With
End Sub  

So that's the start of the solution, but this will get maddening for a few reasons. For tables, you'll have to parse the TextRange of every cell individually and pass those TextRanges on to your Refont sub. For charts, you may have to check for every imaginable chart element before setting your TextRange and refonting (my case was more complex than just setting the font to be the theme font, and I didn't have success trying to format the ChartArea all at once).

Are you having the issue with "floating" shapes inside of a chart? When you say "flow chart," is that an embedded Visio diagram or native SmartArt? There are many ways to skin this cat, but the solution will require you to identify every possible type of text container that can be accessed using VBA.

Here's one more tip that might help you get at those floating shapes within charts:

oShp.Chart.Shapes(1).TextFrame.TextRange.Font.Name = "+mn-lt"

But of course first you need to make sure you've got a chart, that it's got shapes in it, that those shapes have a textframe...

Answer 2

If you leverage the features already built in to PowerPoint, you won't need any code at all. The font theme is built to handle these situations. Format all text with font choices that include the (body) or (headings) tag in the name. Then when you switch the font theme from Arial to Calibri, all text, including charts and SmartArt, will be updated.

For a presentation that is already formatted with local formatting instead of using a font theme, unzipping the file to XML and using a good text editor's Find and Replace functions, you can quickly replace all instances of a font without programming. Find 'typeface="Arial"' Replace 'typeface="Calibri"' Then rezip the files and restore the file ending.

Answer 3

It seems you only need to change the master slides (including notesmaster, slidemaster), instead of working on each slide. Here are my codes

Sub ChangeFont()
    ' https://stackoverflow.com/a/57212464/2292993
    ' affect SmartArt font
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.majorFont.Item(1) = "Garamond"
    ActivePresentation.SlideMaster.Theme.ThemeFontScheme.minorFont.Item(1) = "Garamond"

    For i = 1 To Application.ActivePresentation.NotesMaster.Shapes.Count
        With Application.ActivePresentation.NotesMaster.Shapes(i).TextFrame.TextRange.Font
            .Name = "Garamond"
             If Application.ActivePresentation.NotesMaster.Shapes(i).Name Like "Notes*" Then
                .Bold = msoFalse
                .Size = 16
             End If
        End With
    Next i
    
    ' http://skp.mvps.org/2007/ppt003.htm
    ' Each design contained a slide master and possibly a title master. Several designs could be stored within a presentation.
    ' The slide master can contain several custom layouts which can be fully customized. 
    For Each oDesign In ActivePresentation.Designs
        ' slide master
        Set sm = oDesign.SlideMaster
        For j = 1 To sm.Shapes.Count
            If sm.Shapes(j).HasTextFrame Then
            With sm.Shapes(j).TextFrame.TextRange.Font
            .Name = "Garamond"
            End With
            End If
        Next j

        ' custom layouts
        lngLayoutCount = oDesign.SlideMaster.CustomLayouts.Count
        For I = 1 To lngLayoutCount
            Set oCL = oDesign.SlideMaster.CustomLayouts(I)
            For j = 1 To oCL.Shapes.Count
                If oCL.Shapes(j).HasTextFrame Then
                With oCL.Shapes(j).TextFrame.TextRange.Font
                .Name = "Garamond"
                End With
                End If
            Next j
        Next I
    Next
End Sub