Question

我正在创建多个宏以自动格式化一系列幻灯片，其中一个宏是为整个Powerpoint的所有文本框设置字体。我有设置它们的代码，但是为了处理错误，我需要确保用户输入的字体是有效字体，因此，我需要Powerpoint已安装的所有字体的完整集合。我的代码如下：

Private Sub ChangeTextFont_Click()

Dim oSl As Slide
Dim oSh As Shape
Dim strFontName As String
Dim ValidFont As Font

strFontName = InputBox("Enter the name of the font to use for the text on the screens or press Cancel to keep the existing font.", "Enter Font Name")

If Trim(strFontName) = "" Then Exit Sub

'For Each ValidFont In <collection of all fonts powerpoint has>    <-------- this is my issue
    If strFontName = ValidFont Then
        With ActivePresentation
            For Each oSl In .Slides
                For Each oSh In oSl.Shapes
                    With oSh
                        If .HasTextFrame Then
                            If .TextFrame.HasText Then
                                If oSl.Name <> "Config" Then
                                    .TextFrame.TextRange.Font.Name = strFontName
                                End If
                            End If
                        End If
                    End With
                Next
            Next
        End With
    End If
'Next
End Sub

我尝试了几种解决方案，但没有一个能完全发挥作用。理想情况下，我需要仅使用PowerPoint的解决方案（不要启动单词，因为它具有不同的字体选择），并且不要太长，因为这不应该是一个难题。

这可能使人全神贯注，所以请多多帮助。

Answer 1

最后，这是最容易从单词中提取列表的方法。我以为列表不一样，但这是由于我正在比较的文档中缓存了字体。无论如何，要找到一个好的解决方案，请查看以下问题的答案：Get a list of all fonts in VBA Excel 2010

Answer 2

您可以尝试在安装目录中的Microsoft Office\root\Office16\1033\PUBFTSCM\FONTSCHM.INI文件中查找，然后解析该文件...

不确定其中的数据类型会有帮助，但这只是一个开始。

尝试获取字体的完整列表powerpoint也可以访问以与用户输入进行比较

2 个答案: