Wordの「スタイル」をVBAで操作する(3) (Word)

「標準」スタイルのフォントを変更するメソッド

前回

akashi-keirin.hatenablog.com

のつづき。

一発で「標準」スタイルのフォント設定を変更することができるようなマクロを作ってみる。

リスト１　標準モジュール

'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim styleIndex As Long
  styleIndex = getStandardStyleIndex(ThisDocument)    '……(1)'
  If styleIndex = -1 Then Exit Sub    '……(6)'
  With ThisDocument
    Dim fontBeforeChange As String
    If isFarEast Then    '……(7)'
      fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
    Else
      fontBeforeChange = .Styles(styleIndex).Font.Name
    End If
  End With
On Error GoTo errorHandler
  With ThisDocument.Styles(styleIndex).Font    '……(8)'
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With ThisDocument    '……(9)'
    If isFarEast Then
      .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
    Else
      .Styles(styleIndex).Font.Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルのインデックス番号を取得する'
Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long    '……(2)'
  With targetDocument
    Dim i As Long
    For i = 1 To .Styles.Count    '……(3)'
      With .Styles(i)
        If .NameLocal = "標準" Then _
          getStandardStyleIndex = i: Exit Function    '……(4)'
      End With
    Next
  End With
  getStandardStyleIndex = -1    '……(5)'
End Function

メインはsetFontForStandardStyleプロシージャ。途中getStandardStyleIndexプロシージャを呼び出す、という形になっている。

まず、いきなり(1)の

styleIndex = getStandardStyleIndex(ThisDocument)

でgetStandardStyleIndexを呼び、返り値をstyleIndexに突っ込む。

getStandardStyleIndexプロシージャは、ドキュメントの「標準」スタイルのインデックス番号を割り出すFunction。

さっそく中身を見ていく。

まず(2)の

Private Function getStandardStyleIndex( _
                   ByVal targetDocument As Document) As Long

は、おなじみの引数設定と返り値設定。

対象のDocumentを受けとって、「標準」スタイルのインデックスを返す。

内部では、(3)からの５行（実質４行）

For i = 1 To .Styles.Count
  With .Styles(i)
    If .NameLocal = "標準" Then _
      getStandardStyleIndex = i: Exit Function    '……(4)'
  End With
Next

で、For ～ Nextを用いて「標準」スタイルのインデックス番号を割り出す。

(targetDocument).Styles(i)で取り出した一つ一つのDocument.Styleオブジェクトについて、(4)の

If .NameLocal = "標準" Then getStandardStyleIndex = i: Exit Function

でNameLocalプロパティが「標準」かどうかを調べ、「標準」だったらその時点でのiの値をreturnする、というもの。

もし一致しなければ（異常事態だけれど）、Forループから抜けることになるので、(5)の

getStandardStyleIndex = -1

で「-1」（あり得ない値）をreturnする。

処理がsetFontForStandardStyleプロシージャに戻ってくると、すかさず(6)の

If styleIndex = -1 Then Exit Sub

で返り値チェック。

「-1」が返っていたとしたら異常事態なので、何もせずにExitする。

(6)を無事通過したら、あとはメインの処理へ。

……とその前に下ごしらえを。(7)からの５行

If isFarEast Then    '……(7)'
  fontBeforeChange = .Styles(styleIndex).Font.NameFarEast
Else
  fontBeforeChange = .Styles(styleIndex).Font.Name
End If

で、引数isFarEastの値に応じて処理を分ける。

isFarEastがTrueだったら、現時点の日本語用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

逆に、isFarEastがFalseだったら、現時点の英数字用フォントの名前を変数fontBeforeChangeにぶち込んでおく。

この後の処理でエラーが出るなどして実行できなかったときに、フォント設定を元に戻すため。

やっとメインの処理。(8)からの４行

With ThisDocument.Styles(styleIndex).Font    '……(8)'
  If isFarEast Then .NameFarEast = fontName: Exit Sub
  If Not isFarEast Then .Name = fontName: Exit Sub
End With

で、Document.Style.FontオブジェクトのNameFarEastまたはNameプロパティを設定する。

このとき、存在しないフォント名を渡したとかでエラーが出たら、(9)からの７行

With ThisDocument
  If isFarEast Then
    .Styles(styleIndex).Font.NameFarEast = fontBeforeChange
  Else
    .Styles(styleIndex).Font.Name = fontBeforeChange
  End If
End With

でフォント設定を元に戻すようにした。

使ってみる

getStandardStyleIndexプロシージャ

まずは、getStandardStyleIndexプロシージャを使ってみる。

イミディエイト・ウィンドウに、

?WdCommon.getStandardStyleIndex(ThisDocument)

と入力して[Enter]。

ちなみに、

akashi-keirin.hatenablog.com

このときにも紹介したように、Privateメソッドであっても、[モジュール名].[メソッド名]とすれば、イミディエイト・ウィンドウで実行することができる。

ちゃんと「194」が返っている。

setFontForStandardStyleプロシージャ

次のコードで実行してみる。

リスト２　標準モジュール

Public Sub testSetFontForStandardStyle()
  Call setFontForStandardStyle("ＭＳ ゴシック", True)
End Sub

setFontForStandardStyleの引数fontNameに「"ＭＳ ゴシック"」を、引数isFarEastに「True」を渡しているだけ。意図どおりならば、日本語用フォントが「ＭＳ ゴシック」になるはず。

実行結果

この状態で実行すると、

こうなる。意図どおり。

このマクロをクイック アクセス ツール バーにでも仕込んでおいたら、１クリックで「標準」スタイルのフォント設定を変えることができるし、Dir関数、Documents.Openメソッドと組み合わせたらフルオートでフォルダ内一括変換とかもできそう。あんまり需要はないだろうけれど。

追記

コードを修正しました。

リスト２　標準モジュール

'///標準スタイルのフォントを設定する'
Public Sub setFontForStandardStyle(ByVal fontName As String, _
                                   Optional ByVal isFarEast As Boolean = False)
  Dim standardStyle As Style
  Set standardStyle = getStandardStyle(ThisDocument)
  If standardStyle Is Nothing Then Exit Sub
  With standardStyle.Font
    Dim fontBeforeChange As String
    If isFarEast Then
      fontBeforeChange = .NameFarEast
    Else
      fontBeforeChange = .Name
    End If
  End With
On Error GoTo errorHandler
  With standardStyle.Font
    If isFarEast Then .NameFarEast = fontName: Exit Sub
    If Not isFarEast Then .Name = fontName: Exit Sub
  End With
errorHandler:
  With standardStyle.Font
    If isFarEast Then
      .NameFarEast = fontBeforeChange
    Else
      .Name = fontBeforeChange
    End If
  End With
End Sub
'「標準」スタイルを取得する'
Private Function getStandardStyle( _
                   ByVal targetDocument As Document) As Style
  With targetDocument
    Dim targetStyle As Style
    For Each targetStyle In .Styles
      If targetStyle.NameLocal = "標準" Then _
          Set getStandardStyle = targetStyle: Exit Function
    Next
  End With
  Set getStandardStyle = Nothing
End Function

直接Styleオブジェクトを取得する形にしました。