有谁知道如何使用VBA检测Powerpoint 2007幻灯片对象中主题字体的使用?如果查看Shape.TextFrame.TextRange.Font.Name
字体名称显示为简单名称(例如:“Arial”),无论字体是否已指定为固定名称或主题名称(可根据文档主题进行更改)。我没有在对象模型中看到任何其他属性将该名称标记为与主题相关联(例如,对于颜色为ObjectThemeColor
)。
谢谢!
答案 0 :(得分: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
答案 1 :(得分:0)
由于@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