Question

有谁知道如何使用VBA检测Powerpoint 2007幻灯片对象中主题字体的使用？如果查看Shape.TextFrame.TextRange.Font.Name字体名称显示为简单名称（例如：“Arial”），无论字体是否已指定为固定名称或主题名称（可根据文档主题进行更改）。我没有在对象模型中看到任何其他属性将该名称标记为与主题相关联（例如，对于颜色为ObjectThemeColor）。

谢谢！

Answer 1

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

由于@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

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

2 个答案: