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

Question

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

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

Answer 1

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

• < w:embedRegular>
• < w:embedBold>
• < w:embedItalic>
• < w:embedBoldItalic>

（必须输入空格，否则无法正确显示）

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

基于此，您可以将一些东西放在一起以提取此信息 - 我在下面放置了一个查看活动文档的示例。

我不得不承认这不是那么漂亮，它当然可以通过一些优化来完成，但它确实有效。不要忘记在您的 VBA 项目中添加对 MSXML 的引用。

' 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