How to detect Theme fonts in Powerpoint 2007 VBA? - vba

Question

Does anyone know how to detect the use of Theme fonts in Powerpoint 2007 slide objects using VBA? If one looks at Shape.TextFrame.TextRange.Font.Name the font name appears as simple name (ex: "Arial") whether or not the font was assigned as a fixed name or a Theme name (subject to change with the document theme). I don't see any other property in the Object Model that would flag the name as tied to a theme (such as ObjectThemeColor for colors).
Thanks!

Answer 1

There is no direct method (that I know of), however you can check with an If/Then:
Sub checkthemeFont()
Dim s As Shape
Set s = ActivePresentation.Slides(1).Shapes(1)
Dim f As Font
Set f = s.TextFrame.TextRange.Font
Dim themeFonts As themeFonts
Dim majorFont As ThemeFont
Set themeFonts = ActivePresentation.SlideMaster.Theme.ThemeFontScheme.MajorFont
Set majorFont = themeFonts(msoThemeLatin)
If f.Name = majorFont Then
Debug.Print f.Name
End If
End Sub

Answer 2

Thanks to the idea from #tobriand here is an implementation that reports if any placeholders are set to hard coded fonts rather than those from the theme:
Option Explicit
' =================================================================================
' PowerPoint VBA macro to check if all text-supporting placeholders are set
' to use one of the two theme fonts or are "hard coded".
' Checks all slide masters in the active presentation.
' Author : Jamie Garroch
' Company : BrightCarbon Ltd. (https://brightcarbon.com/)
' Date : 05MAR2020
' =================================================================================
Public Sub CheckMastersUseThemeFonts()
Dim oDes As Design
Dim oCL As CustomLayout
Dim oShp As Shape
Dim tMinor As String, tMajor As String
Dim bFound As Boolean
Dim lMasters, lLayouts, lPlaceholders
' If you use Arial, change this to any font not used in your template
Const TEMP_FONT = "Arial"
For Each oDes In ActivePresentation.Designs
lMasters = lMasters + 1
' Save the current theme fonts before changing them
With oDes.SlideMaster.Theme.ThemeFontScheme
tMajor = .MajorFont(msoThemeLatin).Name
tMinor = .MinorFont(msoThemeLatin).Name
.MajorFont(msoThemeLatin).Name = TEMP_FONT
.MinorFont(msoThemeLatin).Name = TEMP_FONT
End With
' Check if any are not set to the temporary font, indicating hard coding
For Each oCL In oDes.SlideMaster.CustomLayouts
lLayouts = lLayouts + 1
For Each oShp In oCL.Shapes
If oShp.Type = msoPlaceholder Then lPlaceholders = lPlaceholders + 1
If oShp.HasTextFrame Then
Select Case oShp.TextFrame.TextRange.Font.Name
Case "Arial"
Case Else
bFound = True
Debug.Print oShp.TextFrame.TextRange.Font.Name, oDes.Name, oCL.Name, oShp.Name
End Select
End If
Next
Next
' Restore the original fonts
With oDes.SlideMaster.Theme.ThemeFontScheme
.MajorFont(msoThemeLatin).Name = tMajor
.MinorFont(msoThemeLatin).Name = tMinor
End With
Next
If bFound Then
MsgBox "Some placeholders are not set to use the theme fonts. Press Alt+F11 to see them in the Immediate pane.", vbCritical + vbOKOnly, "BrightSlide - Master Theme Fonts"
Else
MsgBox "All placeholders are set to use the theme fonts.", vbInformation + vbOKOnly, "BrightSlide - Master Theme Fonts"
End If
' Provide some stats on what was checked
Debug.Print "Masters: " & lMasters
Debug.Print "Layouts: " & lLayouts
Debug.Print "Placeholders: " & lPlaceholders
End Sub