Wordの「スタイル」をVBAで操作する(3) (Word)
「標準」スタイルのフォントを変更するメソッド
前回
のつづき。
一発で「標準」スタイルのフォント設定を変更することができるようなマクロを作ってみる。
リスト1 標準モジュール
'///標準スタイルのフォントを設定する' 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)からの5行(実質4行)
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)からの5行
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)からの4行
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)からの7行
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]。
ちなみに、
このときにも紹介したように、Private
メソッドであっても、[モジュール名].[メソッド名]
とすれば、イミディエイト・ウィンドウで実行することができる。
ちゃんと「194
」が返っている。
setFontForStandardStyle
プロシージャ
次のコードで実行してみる。
リスト2 標準モジュール
Public Sub testSetFontForStandardStyle() Call setFontForStandardStyle("MS ゴシック", True) End Sub
setFontForStandardStyle
の引数fontName
に「"MS ゴシック"
」を、引数isFarEast
に「True
」を渡しているだけ。意図どおりならば、日本語用フォントが「MS ゴシック」になるはず。
実行結果
この状態で実行すると、
こうなる。意図どおり。
このマクロをクイック アクセス ツール バーにでも仕込んでおいたら、1クリックで「標準」スタイルのフォント設定を変えることができるし、Dir
関数、Documents.Open
メソッドと組み合わせたらフルオートでフォルダ内一括変換とかもできそう。あんまり需要はないだろうけれど。
追記
コードを修正しました。
リスト2 標準モジュール
'///標準スタイルのフォントを設定する' 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
オブジェクトを取得する形にしました。