vba - 使用 VBA 确定 Word 文档是否包含受限字体

Question

有没有办法使用 VBA 确定 Word 文档(特别是 2007，如果重要的话)是否包含受限字体？

我不一定需要一种方法来删除 字体，只是为了确定文档是否包含受限字体。此外，如果只有一种方法可以检查嵌入 字体，那是可以接受的，因为在我的情况下，它几乎总是受限制的字体。

Answer 1

当您使用 Word 2007 时，您可以尝试检查文档的 OOXML 以检查是否嵌入了特定字体。据我所知，如果它嵌入到 XML 中，字体将具有以下一个或多个子节点:

(必须加空格否则显示不正确)

更多信息在这里:http://msdn.microsoft.com/en-us/library/documentformat.openxml.wordprocessing.font.aspx

在此基础上，您可以将一些东西组合在一起以提取此信息 - 我在下面组合了一个查看事件文档的示例。

我不得不承认这不是那么漂亮，它当然可以做一些优化，但它完成了工作。不要忘记将对 MSXML 的引用添加到您的 VBA 项目。

' returns a delimited list of fonts that are embedded
Function GetEmbeddedFontList(Optional ByVal sDelimiter As String = ";") As String

   Dim objDOMDocument As MSXML2.DOMDocument30
   Dim objXMLNodeList As MSXML2.IXMLDOMNodeList
   Dim objXMLNodeListEmbed As MSXML2.IXMLDOMNodeList
   Dim lNodeNum As Long
   Dim lNodeNum2 As Long
   Dim sFontName As String
   Dim sReturnValue As String

   On Error GoTo ErrorHandler

   sReturnValue = ""

   Set objDOMDocument = New MSXML2.DOMDocument30
   objDOMDocument.LoadXML ActiveDocument.WordOpenXML

   ' grab the list of fonts used in the document
   Set objXMLNodeList = objDOMDocument.SelectNodes("//w:fonts/w:font")

   For lNodeNum = 0 To objXMLNodeList.Length - 1

      ' obtain the font's name
      sFontName = objXMLNodeList.Item(lNodeNum).Attributes(0).Text

      'check its child nodes to see if any contain the word "embed", if so, then the font is embedded
      For lNodeNum2 = 0 To objXMLNodeList.Item(lNodeNum).ChildNodes.Length - 1

         If objXMLNodeList.Item(lNodeNum).ChildNodes(lNodeNum2).nodeName Like "*embed*" Then

            sReturnValue = sReturnValue & sFontName & sDelimiter  ' add it to the list

            Exit For

         End If

      Next lNodeNum2

   Next lNodeNum

ErrorExit:

   GetEmbeddedFontList = sReturnValue

   Exit Function

ErrorHandler:

   sReturnValue = ""

   Resume ErrorExit:

End Function