Picture The Font Problem

The two theme fonts appear at the top of the font list

This is a typical scenario when updating presentations to use new designs, templates, themes or just when you’re pasting slides from one deck to another.

The slides come across with all of your lovingly created content but you need to change all the fonts to use those defined in your theme.

As a brief reminder, a Microsoft Office theme defines a pair of fonts; major and minor, or to put in another way for PowerPoint users, Headings and Body, as seen here on the right.

There is a font replacement tool built into PowerPoint 2013, 2010 and 2007 but it doesn’t allow you to change fonts to those defined in your theme.

Home | Editing | Replace | Replace Fonts

>>>

No way to choose theme fonts!

This is a major issue if you want your slides to adapt to theme changes in the future, rather than manually selecting each and every object that contains text in your presentation and then setting the font to use one of the two defined by your theme.  By setting every text object to use your theme defined fonts (instead of a direct named font), you can change the font for tens, hundreds or even thousands of objects across your presentation with one simple font change in your theme.  But setting all your objects to use the theme font in the first place has to be done manually… or does it?

So What’s The Solution?

Since PowerPoint doesn’t provide a way to replace a font with one specified by your theme, we need to add a macro to do this. Macros are small bits of code that provide PowerPoint with instructions to do things and they are great for automating a repetitive task, exactly what we have here.

To add our FontsToTheme macro, follow these steps:

Alt+F8 shows you a list of macros available

*You may also want to enable the Developer tab in the PowerPoint ribbon if you can’t see it as it adds all the VBA tools you need.

How Does It Work?

When done, see how much time you saved!

This macro searches through every slide of your presentation, looking for shapes or tables (within or outside of groups) that have text in them but are not title placeholders.  When it finds something matching these criterion, it changes the font to the minor (Body) font defined by the theme.

If it finds something it doesn’t know how to handle, it will show an error message. Once completed, it will show a brief message about what it changed.

If you want to undo the change, simply go to your presentation and press Ctrl-Z.

The All Important Macro

Option Explicit
 
Public Const sThemeMajorFont = “+mj-lt”
Public Const sThemeMinorFont = “+mn-lt”
 
Sub FontsToTheme()
    Dim oSld As Slide
    Dim oShp As Shape
    Dim iGroupItem As Integer, iSlidesSearched As Integer, iShapesSearched As Integer, iShapesChanged As Integer
    Dim response As Integer
    On Error GoTo errorhandler
    
    For Each oSld In ActivePresentation.Slides
        iSlidesSearched = iSlidesSearched + 1
        For Each oShp In oSld.Shapes
            iShapesSearched = iShapesSearched + 1
            If oShp.HasTable Then
                RefontTable oShp.Table
                iShapesChanged = iShapesChanged + 1
                GoTo quitfor
            End If
            If oShp.HasTextFrame Then
                iShapesChanged = iShapesChanged + 1
                oShp.TextFrame.TextRange.Font.Name = sThemeMinorFont
                GoTo quitfor
            End If
            If oShp.Type = msoGroup Then
                For iGroupItem = 1 To oShp.GroupItems.Count
                    With oShp.GroupItems(iGroupItem)
                        iShapesSearched = iShapesSearched + 1
                        If .HasTextFrame = msoTrue Then
                            iShapesChanged = iShapesChanged + 1
                            .TextFrame.TextRange.Font.Name = sThemeMinorFont
                        End If
                    End With
                Next
            End If
quitfor:
        Next
    Next
    MsgBox “Slides searched : ” & iSlidesSearched & vbCrLf & _
        “Shapes searched : ” & iShapesSearched & vbCrLf & _
        “Shapes changed : ” & iShapesChanged, vbOKOnly + vbInformation, “FontsToTheme Complete”
    Exit Sub
 
errorhandler:
    response = MsgBox(“There was an error processing this shape” & vbCrLf & vbCrLf & _
        “Slide : ” & oSld.SlideIndex & ” Shape : ” & oShp.Name & vbCrLf & vbCrLf & _
        “Click OK to continue or Cancel to stop.”, vbCritical + vbOKCancel, “Error processing shape!”)
    If response = vbOK Then
        Err.Clear
        Resume Next
    Else
        End
    End If
 
End Sub
 
Sub RefontTable(oTable As Table)
    Dim lRow As Long
    Dim lCol As Long
    For lRow = 1 To oTable.Rows.Count
        For lCol = 1 To oTable.Columns.Count
            With oTable.Rows(lRow).Cells(lCol).Shape.TextFrame.TextRange.Font
                .Name = sThemeMinorFont
            End With
        Next
    Next
End Sub

Saving Your presentation

It’s best to save your presentation without the macro code otherwise your recipients will see all sorts of security messages. To do this, just save as a .pptx as normal and when asked if you want to save as a macro free presentation,. click yes. If you want to keep the macro in the presentation, you’ll need to save it in one of the macro compatible formats such as .pptm

Disclaimer

There are many different object types and scenari in PowerPoint and this macro has only been designed to handle the basics.  It doesn’t know anything about charts for example so those won’t be changed. The macro may be used for free and/or modified, without license, as is. GMARK do not accept liability for any loss of data or damage as a result of using this free code.