繰り返しを伴う処理をまとめる
フィールドコード総ナメ方式のプロシージャをまとめる
前回までの3回
で紹介したFunctionを使って、選択範囲のフィールドコードを総当たりで処理するプロシージャを作ってみた。
たとえば、ルビの割り付け位置を設定するgetConvertedAlignmentRubyFieldCodeText
の場合だと、次のようなものになる。
リスト1 標準モジュール
Private Sub changeSelectionRubiesalign( _ ByVal targetSelection As Selection, _ ByVal targetAlignCode As AlignCode) '……(1)' On Error GoTo Finalizer Application.ScreenUpdating = False Dim orgRange As Range Set orgRange = targetSelection.Range Dim targetField As Field For Each targetField In orgRange.Fields With targetField If .Type = wdFieldFormula And _ (InStr(1, .Code.Text, "\s\up") > 0 Or _ InStr(1, .Code.Text, "\s\do") > 0) Then .Code.Text = _ getConvertedAlignmentRubyFieldCodeText(.Code.Text, _ targetAlignCode) '……(2)' End If End With Next Finalizer: Application.ScreenUpdating = True End Sub
全てのフィールドコードを総当たりで調べて、ルビに関するフィールドコードだったらgetConvertedAlignmentRubyFieldCodeText
で書き換えたフィールドコード文字列を取得して、Field.Code.Text
プロパティを書き換える。
上記の例は、ルビの割り付けに関するものだが、これをルビのサイズとか、ルビのフォントの種類を変更するものに変えようとすると、変更箇所はわづかにリスト内の(1)と(2)の箇所だけである。
コピペして(1)と(2)の箇所だけ書き換えたプロシージャを作っても良いが、それではモジュール内の見通しが悪くなってしまう。
そこで、繰り返し処理の部分は共通化してしまうことを考えた。
繰り返し処理部分を共通化したコード
リスト2 標準モジュール宣言セクション
まずは、列挙体と定数。
'Enums' Public Enum AlignCode acAlignCenter = 0 '中央揃え' acAlignDistribution1 '均等割付1' acAlignDistribution2 '均等割付2' acAlignLeft '左揃え' acAlignRight '右揃え' End Enum Private Enum SettingCode scAlign scFontSize scFontName End Enum 'Constants' Private Const MAX_RUBY_SIZE As Single = 20 Private Const STANDARD_RUBY_FONT As String = "MS 明朝"
外部から呼び出すときに使う必要性が生じるので、AlignCode
についてはPublic
指定に変更。
リスト3 標準モジュール
Private Sub changeSelectionRubiesSetting( _ ByVal targetSelection As Selection, _ ByVal targetArg As Variant, _ ByVal settingType As SettingCode) '……(3)' On Error GoTo Finalizer Application.ScreenUpdating = False Dim orgRange As Range Set orgRange = targetSelection.Range Dim targetField As Field For Each targetField In orgRange.Fields With targetField If .Type = wdFieldFormula And _ (InStr(1, .Code.Text, "\s\up") > 0 Or _ InStr(1, .Code.Text, "\s\do") > 0) Then .Code.Text = getRubiesSettingFieldCodeText(.Code.Text, _ targetArg, _ settingType) '……(4)' End If End With Next Finalizer: Application.ScreenUpdating = True End Sub Private Function getRubiesSettingFieldCodeText( _ ByVal fieldCodeText As String, _ ByVal receiptArg As Variant, _ ByVal settingType As SettingCode) As String On Error GoTo Finalizer Dim ret As String ret = fieldCodeText Select Case settingType '……(5)' Case scAlign ret = getConvertedAlignmentRubyFieldCodeText( _ fieldCodeText, CInt(receiptArg)) Case scFontSize: ret = getChangedRubySizeFieldCodeText( _ fieldCodeText, CSng(receiptArg)) Case scFontName: ret = getChangedRubyFontNameFieldCodeText( _ fieldCodeText, CStr(receiptArg)) End Select Finalizer: getRubiesSettingFieldCodeText = ret End Function
上段のchangeSelectionRubiesSetting
が3メソッド共通の入り口。
(3)の
Private Sub changeSelectionRubiesSetting( _ ByVal targetSelection As Selection, _ ByVal targetArg As Variant, _ ByVal settingType As SettingCode)
を見ればおわかりのように、第3引数targetArg
でどんな種類の引数でも受け取れるようにしておき、第4引数のsettingType
でどの処理を呼び出すのかを指定する。
今回は引数チェックのガード節はまだ追加していない。
(4)の
.Code.Text = getRubiesSettingFieldCodeText(.Code.Text, _ targetArg, _ settingType)
まで来たら、下段のgetRubiesSettingFieldCodeText
メソッドを呼び出す。
getRubiesSettingFieldCodeText
メソッド内では、(5)の
Select Case settingType Case scAlign ret = getConvertedAlignmentRubyFieldCodeText( _ fieldCodeText, CInt(receiptArg)) Case scFontSize: ret = getChangedRubySizeFieldCodeText( _ fieldCodeText, CSng(receiptArg)) Case scFontName: ret = getChangedRubyFontNameFieldCodeText( _ fieldCodeText, CStr(receiptArg)) End Select
で、引数settingType
の値に応じて、getConvertedAlignmentRubyFieldCodeText
、getChangedRubySizeFieldCodeText
、getChangedRubyFontNameFieldCodeText
のうちいづれかを呼び出してフィールドコード文字列を得る。(以上3メソッドのコードについては、下のリスト5に再掲します。)
必要ないかも知れないけれど、Variant
で受け取った引数receiptArg
は、一応キャストして各メソッドに渡すようにしている。
使ってみる
次のような呼び出し用プロシージャで利用する。
リスト4-1 標準モジュール
'///選択範囲のルビ割付を一括変換' Public Sub changeSelectionRubiesAlign(ByVal targetAlignCode As AlignCode) Call changeSelectionRubiesSetting(Selection, _ targetAlignCode, _ scAlign) End Sub '///選択範囲のルビサイズを一括変換' Public Sub changeSelectionRubiesSize(ByVal targetSize As Single) Call changeSelectionRubiesSetting(Selection, _ targetSize, _ scFontSize) End Sub '///選択範囲のルビのフォントを一括変換' Public Sub changeSelectionRubiesFontName(ByVal targetFontName As String) Call changeSelectionRubiesSetting(Selection, _ targetFontName, _ scFontName) End Sub
おわりに
こんな風に動作します。
参考
リスト5 標準モジュール
'///ルビの割り付け位置を変更する' Private Function getConvertedAlignmentRubyFieldCodeText( _ ByVal targetFieldCodeText As String, _ ByVal targetAlignCode As AlignCode) As String Dim ret As String ret = targetFieldCodeText If targetAlignCode < 0 Or _ targetAlignCode > 4 Then GoTo Finalizer ret = getRepairedFieldCodeText(ret) Dim alignSetting1 As String Dim alignSetting2 As String Select Case targetAlignCode Case acAlignCenter alignSetting1 = "* jc0 ": alignSetting2 = "ac(" Case acAlignDistribution1 alignSetting1 = "* jc1 ": alignSetting2 = "ad(" Case acAlignDistribution2 alignSetting1 = "* jc2 ": alignSetting2 = "ad(" Case acAlignLeft alignSetting1 = "* jc3 ": alignSetting2 = "al(" Case acAlignRight alignSetting1 = "* jc4 ": alignSetting2 = "ar(" End Select Dim ar As Variant ar = Split(ret, "\") '" ar(1) = alignSetting1 ar(5) = alignSetting2 ret = getAssembledFieldCodeText(ar) Finalizer: getConvertedAlignmentRubyFieldCodeText = ret End Function '///ルビのサイズを変更する' Private Function getChangedRubySizeFieldCodeText( _ ByVal targetFieldCodeText As String, _ ByVal targetSize As Single) As String Dim ret As String ret = targetFieldCodeText If targetSize > MAX_RUBY_SIZE Then GoTo Finalizer ret = getRepairedFieldCodeText(ret) Dim ar As Variant ar = Split(targetFieldCodeText, "\") '" ar(3) = "* hps" & targetSize * 2 ret = getAssembledFieldCodeText(ar) Finalizer: getChangedRubySizeFieldCodeText = ret End Function '///ルビのフォントの種類を変更する' Private Function getChangedRubyFontNameFieldCodeText( _ ByVal targetFieldCodeText As String, _ Optional ByVal targetFontName As String = STANDARD_RUBY_FONT) As String Dim ret As String ret = targetFieldCodeText ret = getRepairedFieldCodeText(ret) Dim ar As Variant ar = Split(ret, "\") '" ar(2) = "* " & """Font:" & targetFontName & """" ret = getAssembledFieldCodeText(ar) Finalizer: getChangedRubyFontNameFieldCodeText = ret End Function '///SplitでバラしたFieldCodeを元通りにする' Private Function getAssembledFieldCodeText( _ ByRef splitFieldCode As Variant) As String Dim i As Long Dim ret As String For i = LBound(splitFieldCode) To UBound(splitFieldCode) ret = ret & splitFieldCode(i) & "\" '" Next ret = Left(ret, Len(ret) - 1) getAssembledFieldCodeText = ret End Function '///手動で「中央揃え」にしたときのスイッチ省略への対応' Private Function getRepairedFieldCodeText( _ ByVal targetFieldCodeText) As String Dim ret As String ret = targetFieldCodeText Dim ar As Variant ar = Split(ret, "\") '" 'インデックスの最大値が「7」だったら、省略されていない。' If UBound(ar) = 7 Then GoTo Finalizer '省略を補う処理' ReDim Preserve ar(7) ar(7) = ar(6) ar(6) = ar(5) ar(5) = "ac(" ar(4) = "o" '手動で「中央揃え」にした後だと、 ar(4) の値が"o("になるときがある。' ret = getAssembledFieldCodeText(ar) Finalizer: getRepairedFieldCodeText = ret End Function