How to detect Theme fonts in Powerpoint 2007 VBA?

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 The开发者_开发问答me 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!

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

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