3

VBAを使用して、Word文書（特に2007年）に制限付きフォントが含まれているかどうかを判断する方法はありますか？

ドキュメントに制限付きフォントが含まれているかどうかを判断するためだけに、フォントを削除する方法は必ずしも必要ではありません。また、埋め込まれたフォントをチェックする方法しかない場合は、それは許容されます。私の場合、ほとんどの場合、制限されたフォントになるからです。

Wordのスクリーンショット

4

1 に答える 1

3

Word 2007を使用している場合は、ドキュメントのOOXMLを調べて、特定のフォントが埋め込まれているかどうかを確認できます。私が判断できる限り、それがXMLに埋め込まれている場合、フォントには次の子ノードが1つ以上含まれます。

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

（スペースを入れる必要がありました。そうしないと、正しく表示されません）

詳細については、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
于 2011-03-13T13:37:04.823 に答える