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

Question

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

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

Answer 1

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

• ＆LT;瓦特：embedRegular＆GT;
• ＆LT;瓦特：embedBold＆GT;
• ＆LT;瓦特：embedItalic＆GT;
• ＆LT;瓦特：embedBoldItalic＆GT;

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

此处提供更多信息：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