如何在Powerpoint 2007 VBA中检测主题字体？

Question

有人知道如何使用VBA检测Powerpoint 2007幻灯片对象中的主题字体吗？如果查看Shape.TextFrame.TextRange.Font.Name，无论字体是分配为固定名称还是主题名称（受文档主题更改影响），字体名称都显示为简单名称（例如：“Arial”）。我没有看到对象模型中的任何其他属性将名称标记为与主题相关（例如颜色的ObjectThemeColor）。谢谢！

- Sam Russo

Answer 1

感谢 @tobriand 的想法，这里提供一种实现方式，可以报告是否将任何占位符设置为硬编码字体而不是主题中的字体：

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

- Jamie Garroch - MVP

Answer 2

没有直接的方法（据我所知），不过您可以使用 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

- Todd Main

---

谢谢Otaku的回复，但我认为这只告诉你字体名称是否与主题名称匹配，而不是该形状的字体是否受主题设置控制。您可以通过选择文本，在GUI中右键单击并在"主题字体"部分中选择前两个字体之一（主标题和正文字体）来查看此内容。然后添加另一个形状，但从下面的列表中选择相同的字体名称（"所有字体"部分）。两个对象的字体名称看起来相同。更改主题，您会看到第一个形状的字体会更改，但第二个则不会。 - Sam Russo

明白了，是个难题。我只找到了相反的内容，也就是如何设置主题字体（http://pptfaq.com/FAQ00957.htm）。从对象中获取它们作为对象属性的方法似乎没有任何文档资料。 - Todd Main

今天，令我惊讶的是，我正在逐步执行一些代码，我刚刚获得了TextRange.Font.Name中难以捉摸的主题字体名称“+mn-lt”。我认为它并不一致 - 几乎所有其他时间我只看到像“Arial”这样的全名。现在我会准备好两种情况。我认为去掉主题引用的方法始终是使用全名设置字体名称。 - Sam Russo

我意识到这是一个非常古老的问题，但一种方法可能是存储当前的主/次题字体，更改它们，检查所涉及对象的字体是否已更改，然后将其改回... - tobriand

@ToddMain 非常感谢您提供的有价值的参考链接！让我对它的使用有了很好的想法。 - Chandraprakash