VBA で OneNote のセクション内のページのフォントを変更する

はじめに

OneNoteでは、Ctrl+Alt+1で見出し1など、スタイルを設定するショートカットキーは存在するが、そのスタイルをユーザー側では(おそらく)変更できない。

OneNote 2010 まではそのままでも特に気にならなかったが、OneNote 2016 のスタイルが個人的に見にくかったため、それらを一括変更するために以下のマクロを作成した。
ページ単位だと数が多いと面倒だったため、セクション単位で変更するようにしている。

デスクトップ版 OneNote 自体があと6年もすればサポート完全終了なので、それ以降どうするのか、という話はあるけれど……。

コード

最前面にあるセクションから、子どものページを取得し、設定されているフォントを置き換えている(フォント指定はハードコード)。

コード中にも記載しているが、Microsoft OneNote 15.0 Object Libraryなどの参照設定が無いと動かない点に注意。

imihito_Sandbox/M_ChangeOneNoteFont.bas at master · imihito/imihito_Sandbox

'https://github.com/imihito/imihito_Sandbox/blob/master/OneNote/M_ChangeOneNoteFont.bas

'以下の参照設定は必須。
'OneNote = Microsoft OneNote 15.0 Object Library

Public Sub ChangeOneSectionFont()
    'OneNote 取得。
    Dim appOne As OneNote.Application
    Set appOne = VBA.CreateObject("OneNote.Application")

    '最前面のセクションの ID を取得。
        'appOne の型を明示しないと以下のエラーが発生する。
            'オートメーション エラーです。
            'ライブラリは登録されていません｡
    Dim sectId As String
    sectId = appOne.Windows.CurrentWindow.CurrentSectionId

    'セクションのページを示した XML 文字列を取得。
    Dim hierarchyXml As String
    appOne.GetHierarchy sectId, OneNote.HierarchyScope.hsPages, hierarchyXml

    'XML DOM としてロード。
    Dim hierarchyXmlDoc As Object 'As MSXML2.DOMDocument
    Set hierarchyXmlDoc = newXmlDoc(hierarchyXml)

    'ページを取得し、それぞれのフォントを変更。
    Dim node As Object 'As MSXML2.IXMLDOMNode
    For Each node In hierarchyXmlDoc.getElementsByTagName("one:Page")
        ChangeOnePageFont appOne, node.Attributes.getNamedItem("ID").NodeValue
    Next node

End Sub


Public Sub ChangeOnePageFont( _
        inAppOne As OneNote.Application, _
        inPageId As String _
    )

    'ページの内容を取得。
    Dim contentsBuf As String
    inAppOne.GetPageContent inPageId, contentsBuf

    'XML DOM としてロード。
    Dim pageXml As Object 'As MSXML2.DOMDocument
    Set pageXml = newXmlDoc(contentsBuf)

    'スタイルのフォントを変更。
    Const BaseFont = "游ゴシック"
    Const NewFont = "Meiryo UI"

    'BaseFont が指定されているスタイルについてフォントを変更する。
    Dim node As Object 'As MSXML2.IXMLDOMNode
    For Each node In pageXml.SelectNodes("//one:QuickStyleDef[@font='" & BaseFont & "']")
        node.Attributes.getNamedItem("font").NodeValue = NewFont
    Next node


    '変更内容を書き戻し。
    inAppOne.UpdatePageContent pageXml.XML

End Sub

'MSXML2 = Microsoft XML, v3.0
Private Function newXmlDoc(inXmlString As String) As Object 'As MSXML2.DOMDocument
    Dim xmlDoc As Object 'As MSXML2.DOMDocument
    Set xmlDoc = VBA.CreateObject("MSXML2.DOMDocument")
    xmlDoc.LoadXML inXmlString
    Set newXmlDoc = xmlDoc
End Function