Object型変数を積極的に使う

Object型変数を積極的に使う

今まで、Object型の変数を積極的に使うことはなかった。

VBAで作成したツール類も、内輪で使うものばかりなので、CreateObjectを自分から使うことはまずなかった。参照設定してNewばっかりだった。

今回、Object型変数を使ったら便利だな、と思った場面があったので紹介する。

Sheet1オブジェクトにPropertyとメソッドを設定する

シートモジュールにPropertyを設定してみる。

今回は、シートの基準位置を示すセルを、シートオブジェクトのPropertyにする。

リスト1 Sheet1モジュール
Public Property Get BaseCell() As Range
  Set BaseCell = Me.Range("A1")
End Property

たったこれだけの単純なコード。

A1セルを、Sheet1オブジェクトの基準セルを表すBaseCellプロパティに設定している。

次に、Sheet1オブジェクトにメソッドを設定する。

スト2 Sheet1モジュール
Public Sub showBaseCellValue()
  Call MsgBox(Me.BaseCell.Value)
End Sub

ご覧のとおり、MsgBoxを使って、先ほど設定したBaseCellプロパティを参照して得られるRangeオブジェクト(すなわちSheet1オブジェクトのA1セル)の値を表示するだけのメソッド。

使ってみる

Sheet1を、

f:id:akashi_keirin:20181104084322j:plain

このようにしておいて、

次のコードで早速使ってみる。

リスト3 標準モジュール[ModuleMain]
Public Sub showBaseCellValueMain()
  Call Sheet1.showBaseCellValue
End Sub

Sheet1オブジェクトのshowBaseCellValueメソッドを呼び出す。

当然、

f:id:akashi_keirin:20181104084341j:plain

こうなる。

Sheet1オブジェクトのshowBaseCellValueメソッド内部でBaseCellValueプロパティを参照し、A1セルが返るので、A1セルのValueプロパティの値(すなわち「ち~んw」)がメッセージボックスに表示されたわけだ。

Sheet2オブジェクトにもPropertyとメソッドを設定する

同じように、Sheet2オブジェクトにも似たようなPropertyとメソッドを設定してみる。

ただし、今度は、

f:id:akashi_keirin:20181104084430j:plain

このように、基準セルをB2にする。

リスト4 Sheet2モジュール
Public Property Get BaseCell() As Range
  Set BaseCell = Me.Range("B2")
End Property

Public Sub showBaseCellValue()
  Call MsgBox(Me.BaseCell.Value)
End Sub

もはや多言は要すまい。BaseCellプロパティが指し示すセルの位置がB2に変わっただけだ。

使ってみる

今度は、上記のリスト3を次のように変更する。

リスト5 標準モジュール[ModuleMain]
Public Sub showBaseCellValueMain()
'  Sheet1.showBaseCellValue'
  Sheet2.showBaseCellValue
End Sub

Sheet1オブジェクトに対する操作の部分をコメントアウトして、Sheet2オブジェクトのshowBaseCellValueメソッドを呼ぶコードにした。

実行すると、

f:id:akashi_keirin:20181104084438j:plain

当然こうなる。何の不思議もない。

問題

似たようなシートがたくさんあるのだけれど、行き当たりばったりで行や列を追加してしまったせいで、基準位置となるセルがばらばら」みたいなときには、このようにSheetXオブジェクトのPropertyにしてしまう、というのは便利なテクニックだと思う。

ただし、このやり方だと早晩行き詰まることになる。

シートが増えるごとに、「似ているけれど少しづつ異なるコードが量産されてしまう」という問題である。

もちろん、量産する段階では、単純に「コピペして微修正」を繰り返すだけなので、たいした手間ではない。しかし、たとえば今回のshowBaseCellValueに機能を追加しようとしたらどういうことになるか。

もちろん、量産した分だけ手間がかかるのである!

ふつう、こういうときは、「共通部分の括り出し」ということをする。

メソッドの括り出しを試みる

とりあえず、標準モジュールに次のようなコードを書いて括り出してみる。

リスト6 標準モジュール[SheetOperator]

最近、標準モジュールに名前を付けて、メソッドの機能ごとに分ける、ということをしています。今回は、SheetXオブジェクトを操作するメソッドなので、モジュール名を「SheetOperator」にしました。命名方法については、現在試行錯誤中です。参考になるコーディング規約等ございましたら、ご教示ください。

Public Sub showBaseCellValue(ByVal targetSheet As Worksheet)
  Call targetSheet.showBaseCellValue
End Sub

引数でWorksheetオブジェクトを渡して、それぞれのshowBaseCellValueメソッドを実行する、という目論見。

しかしながら、この計画には、実はコード入力時点で既に暗雲が立ちこめている。

f:id:akashi_keirin:20181104084510j:plain

targetSheet.の段階で、入力候補にshowBaseCellValueが出てこないのである。

そして、その嫌な予感は、このメソッドを使ってみるとしっかり当たる。

使ってみる

リスト7 標準モジュール[ModuleMain]
Public Sub showBaseCellValueMain()
'  Sheet1.showBaseCellValue'
'  Sheet2.showBaseCellValue'
  Call SheetOperator.showBaseCellValue(Sheet1)
End Sub

Sheet1を引数として渡して、SheetOperatorモジュールのshowBaseCellValueメソッドを実行する。

すると、

f:id:akashi_keirin:20181104084526j:plain

あえなくコンパイル・エラー!

これは、少し考えれば当たり前の話で、

showBaseCellValueメソッド(BaseCellプロパティも)は、あくまでもSheet1オブジェクト、Sheet2オブジェクトのメソッド(プロパティ)なのであって、Worksheetオブジェクトのメソッド(プロパティ)ではない

ということなのである。

単純な理屈だけれど、案外見落としやすいポイントだと思う。

そこで、Object型の登場

要するに、SheetOperatorモジュールのshowBaseCellValueメソッドにSheet1オブジェクト、Sheet2オブジェクトが渡ればいいのである。

よって、リスト6を次のように修正する。

リスト8 標準モジュール[SheetOperator]
Public Sub showBaseCellValue(ByVal targetSheet As Object)
  Call targetSheet.showBaseCellValue
End Sub

Object型の変数に格納して渡すことで、行った先でもSheet1オブジェクト、Sheet2オブジェクトとして振る舞ってくれるはずだ。

使ってみる

次のコードで実験。

リスト9 標準モジュール[ModuleMain]
Public Sub showBaseCellValueMain()
'  Sheet1.showBaseCellValue'
'  Sheet2.showBaseCellValue'
  Call SheetOperator.showBaseCellValue(Sheet1)
  Call SheetOperator.showBaseCellValue(Sheet2)
End Sub

今度は、

f:id:akashi_keirin:20181104084537j:plain

f:id:akashi_keirin:20181104084551j:plain

うまくいった。

おわりに

Object型の変数を使うことによって、コードを一箇所に集約することができた。

もちろん、Object型の変数(引数)を使うと、コーディング中に入力候補が表示されなくて不便だが、その場合は、コーディング時には今回の場合だったら、ひとまずSheet1で書いておいて、書き終わって実行テストが終わってから一気にtargetSheetに置換する、というやり方をすればいいと思う。

参考

akashi-keirin.hatenablog.com

RangeオブジェクトのNameプロパティのち~んw現象(Excel)

RangeオブジェクトのNameプロパティに関するち~んw珍現象

とにかくご覧いただきたい。

ち~んw珍現象

A1セルに「ち~んw」と入力

f:id:akashi_keirin:20181102212852j:plain

まず、このようにA1セルに「ち~んw」と入力しておく。

イミディエイト・ウインドウで名前を定義

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

Sheet5.Range("A1").Name = hoge

と入力して、そっと[Enter]。

f:id:akashi_keirin:20181102212906j:plain

すると、

f:id:akashi_keirin:20181102212915j:plain

(゚Д゚)ハァ?

なにそれ。

セルの値を変えてみる

ならば、と今度は、セルの値を「hoge」にしてみる。

f:id:akashi_keirin:20181102212922j:plain

んで、同じくイミディエイト・ウインドウに

Sheet5.Range("A1").Name = hoge

と入力して、優しく[Enter]。

f:id:akashi_keirin:20181102212933j:plain

すると、

f:id:akashi_keirin:20181102212943j:plain

????????

さらにセルの値を変えてみる

今度は、

f:id:akashi_keirin:20181102212957j:plain

A1セルの値を「aho」にしたった。

で、これまで同様、イミディエイト・ウインドウに

Sheet5.Range("A1").Name = hoge

と入力して、強く[Enter]。

f:id:akashi_keirin:20181102213017j:plain

まさか……、

f:id:akashi_keirin:20181102213026j:plain

ひええ。やっぱり!

セルの名前が「aho」になっとる!!!!!!!!

おわりに

さっぱりわけがわかりまへん。

ちなみに、「名前の管理」を開けると、

f:id:akashi_keirin:20181102213037j:plain

このように、歴代の名前がどんどん溜まっていくのでした。

選択範囲のルビを除去する(Word)

選択範囲のルビを除去する

青空文庫(HTML版)からWordに文章をコピペすると、

f:id:akashi_keirin:20181021181924j:plain

f:id:akashi_keirin:20181021181933j:plain

こんなふうに、むやみやたらとデカいルビが設定されていて、レイアウトがめちゃくちゃになる。

ルビのサイズを小さくすることも考えたが、ひとまず選択範囲のルビを除去する方向で考えた。

参考サイト

テキトーにggってみると、

みんなのワードマクロ様のページ

様がヒット。

大いに参考にさせていただきました。

ありがとうございます。

要点

みんなのワードマクロ様の記述によると、ポイントは次の3点。すなわち、

  • ルビの部分はフィールドになっている
  • ルビが設定されている場合、フィールドに「\s\up」というスイッチが書かれている
  • PhoneticGuideメソッドを引数を「""」にして実行すると、ルビが解除された状態になる

との由。

なるほど、ルビのところをクリックしてみると、

f:id:akashi_keirin:20181021181941j:plain

確かに、フィールドになっているっぽい。

んで、右クリックしてやると、

f:id:akashi_keirin:20181021181955j:plain

こんなメニューが出る。「フィールド コードの表示/非表示」をクリックすると、

f:id:akashi_keirin:20181021182005j:plain

こんなふうにフィールド コードが表示される。確かに、「\s\up」というのがあるのが見える(赤囲みは実際にはありません。)。

まあ、初心者はコレ見たらビビるやろなw

コード

次のようなメソッドを作った。

リスト1 標準モジュール
Public Sub removeSelectionRubies( _
             ByVal targetSelection As Selection)    '……(1)'
  Dim orgRange As Range
  Set orgRange = targetSelection.Range    '……(2)'
  Dim targetField As Field    '……(3)'
  For Each targetField In orgRange.Fields    '……(4)'
    With targetField
      If .Type = wdFieldFormula And _
         InStr(1, .Code.Text, "\s\up") > 0 Then    '……(5)'
        .Select    '……(6)'
        Call Selection.Range.PhoneticGuide("")    '……(7)'
      End If
    End With
  Next
End Sub

(1)の

Public Sub removeSelectionRubies(ByVal targetSelection As Selection)

では、Selectionオブジェクトを引数として受け取るように指定。

(2)の

Set orgRange = targetSelection.Range

で引数で受け取った選択範囲をRangeオブジェクトとして変数orgRangeにぶち込んでおく。

(3)の

Dim targetField As Field

Field型の変数targetFieldを用意。

(4)からの9行(実質8行)

For Each targetField In orgRange.Fields
  With targetField
    If .Type = wdFieldFormula And _
       InStr(1, .Code.Text, "\s\up") > 0 Then    '……(5)'
      .Select    '……(6)'
      Call Selection.Range.PhoneticGuide("")    '……(7)'
    End If
  End With
Next

では、For Each ~ Nextを用いて、選択範囲の各Fieldオブジェクトに対して処理を行う。

まず、(5)の

If .Type = wdFieldFormula And _
   InStr(1, .Code.Text, "\s\up") > 0 Then

で、Fieldオブジェクトが数式フィールドであるかどうかと、フィールドに「\s\up」が含まれているかどうかを判定。

共にTrueであれば、ルビが設定されているということになるので、(6)の

.Select

で一旦当該のFieldオブジェクトを選択し、(7)の

Call Selection.Range.PhoneticGuide("")

PhoneticGuideメソッドを実行してルビを除去する。

(7)のSelectがちょっとうっとうしいけれど、FieldオブジェクトにはRangeプロパティがないみたいなので、仕方がないのかも。この辺はまだ研究不足です。

実行

こんなふうに、テキトーな範囲をドラッグして選択し、

f:id:akashi_keirin:20181021182020j:plain

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

スト2 標準モジュール
Public Sub removeRubiesMain()
On Error GoTo Finalizer
  Application.ScreenUpdating = False
  Call removeSelectionRubies(Selection)
Finalizer:
  Application.ScreenUpdating = True
End Sub

一応エラー対応とか画面チラつき防止なんかも入れたので行数がかさんでいるけれど、実質1行。

引数にSelectionを渡してremoveSelectionRubiesメソッドを実行しているだけ。

実行結果

f:id:akashi_keirin:20181021182031j:plain

この通り、選択範囲のルビが除去された。

おわりに

フィールドの操作が自在にできるようになったら、WordVBAの可能性も広がるなあ、と感じました。

「写経」用教材を作成する(Word)

「写経」用教材(?)を作成する

Wordの「原稿用紙設定」機能

一太郎』では、「文書スタイル呼び出し」(?)という機能で、コクヨ社の原稿用紙の書式を呼び出すことができる。んで、印刷するときに「升目を印刷する」というチェックボックスにチェックを入れると、まるでモノホンの原稿用紙に印字したかのごとく、プリントアウトすることができる。

Wordの場合、

f:id:akashi_keirin:20181020192727j:plain

このように、「ページ レイアウト」というタブに「原稿用紙設定」というやつがある。

コイツをクリックしてやると、

f:id:akashi_keirin:20181020192737j:plain

こんなウインドウが開くので、画像のように「スタイル」というドロップダウンリストで「マス目付き原稿用紙」を選ぶ。

で、[OK]をクリックしてやると、ややあって画面の表示が切り替わる。

Before

f:id:akashi_keirin:20181020192746j:plain

トンボの位置を見ていただければおわかりのように、余白を極端に狭くしている。(画像の場合、上下左右全て10mmで、とじしろは0mm。)理由はよくわからないが、こうしておかないと、「原稿用紙設定」完了後に行位置が激しくズレータになる。

After

f:id:akashi_keirin:20181020192800j:plain

このように、キレイに原稿用紙に文字列が収まっている。句読点のぶら下げも完璧。

「『写経』用教材」とは

要するに、文章を原稿用紙に書き写すための教材。最近、文章を書き写す、というのが割と(色んな意味で)効果的だなーと思うことが多かったので、市販の書き写し教材みたいなのを簡単に自作できないかなあと思ったのがきっかけ。

もちろん、単純に原稿用紙に書き写せばいいのだけれど、句読点なんかがあらかじめ印字されていれば、写し間違いなんかに早期に気付きやすいかな、と。

また、改段落で字下げされているところなんかは間違いやすそうだから、文の先頭も印字しておけばやりやすいかな、と思って、次のようなスペックを考えた。

  • 句読点や引用符等の記号の類いは印字する(=黒字にする)。
  • 文頭以外の普通の文字は印字しない(=白字にする)。

原則はこれだけ。

使用するメソッド類

これまでに紹介してきたメソッドを使う。

isSignメソッド

akashi-keirin.hatenablog.com

で作成。引数で渡された文字列が記号か文字かを判定する。

getFirstCharPositionメソッド

akashi-keirin.hatenablog.com

で作成。引数で渡されたRangeオブジェクトのうち、初めて普通の文字が出てくるのが何文字目かを返す。

changeFontColorメソッド

akashi-keirin.hatenablog.com

で作成。普通の文字か、記号かによって、フォントの色を変える。

コード

リスト1 標準モジュール
Private Sub changeColorFirstCharOfSentence( _
              ByVal targetSentences As Sentences)    '……(1)'
  Dim targetSentence As Range    '……(2)'
  For Each targetSentence In targetSentences    '……(3)'
    Dim startPosition As Long
    startPosition = getFirstCharPosition(targetSentence)    '……(4)'
    With targetSentence
      If startPosition = .Characters.Count Then Exit Sub    '……(5)'
      Dim i As Long
      For i = startPosition + 1 To .Characters.Count    '……(6)'
        Call changeFontColor(.Characters(i).Font)
      Next
    End With
  Next
End Sub

まず、(1)の

Private Sub changeColorFirstCharOfSentence( _
              ByVal targetSentences As Sentences)

では、引数をSentences型にしている。Sentencesコレクションを受け取って、その要素(つまり、各文)をこのメソッド内で処理してしまおうと考えた。

(2)の

Dim targetSentence As Range

では、次のFor Each ~ Nextで回すためにRange型の変数を用意。Sentencesコレクションの要素がRangeオブジェクトなので、こんなふうになる。

(3)からの11行

For Each targetSentence In targetSentences
  Dim startPosition As Long
  startPosition = getFirstCharPosition(targetSentence)    '……(4)'
  With targetSentence
    If startPosition = .Characters.Count Then Exit Sub    '……(5)'
    Dim i As Long
    For i = startPosition + 1 To .Characters.Count    '……(6)'
      Call changeFontColor(.Characters(i).Font)
    Next
  End With
Next

では、For Each ~ Nextで、引数として受け取ったtargetSentences、つまりSentencesコレクションの各要素を取り出して、順に処理をする。

まず、(4)の

startPosition = getFirstCharPosition(targetSentence)

では、自作のgetFirstCharPositionメソッド(下記のリスト2参照。)を用いて、対象の文の何文字目に初めて普通の文字が出てくるのかを取得し、変数startPositionにぶち込んでいる。

(5)の

If startPosition = .Characters.Count Then Exit Sub

はガード節。文の中で初めて普通の文字が表れる位置と文の文字数が一致している場合(たとえば、「『――あみたいな場合。ちょっと異常だが。)には、何もする必要がない(=白字に変える必要がない)ので、処理を抜ける。

ただし、このガード節は、基本的には文字数0Sentencesコレクションを想定している。文字数0なら何もする必要がないので。

(5)のガード節をくぐり抜けた場合は、処理に移る。ここからが本番。

(6)からの3行

For i = startPosition + 1 To .Characters.Count
  Call changeFontColor(.Characters(i).Font)
Next

では、対象の文の、初めて普通の文字が出てきた位置の次の位置(1文字目は印字したいので。)から最後までループして、それぞれ自作のchangeFontColorメソッド(下記のリスト4参照。)を用いて、それぞれの文字(正確にはFontオブジェクト)について黒字/白字を設定している。

説明はこれでおしまい。以下に処理の中で呼び出される各メソッドのコードを参考に載っけておく。

【参考】リスト2 標準モジュール
Private Function getFirstCharPosition( _
                   ByVal targetSentence As Range) As Long
  Dim ret As Long
  ret = 0
  Dim i As Long
  With targetSentence
    For i = 1 To .Characters.Count
      If Not isSign(.Characters(i)) Then ret = i: Exit For
    Next
    getFirstCharPosition = ret
  End With
End Function
【参考】リスト3 標準モジュール
Private Function isSign( _
                   ByVal targetCharacter As String) As Boolean
  isSign = False
  Dim str As String
  str = "、 。 , . ・ : ; ? ! "
  str = str & "゛ ゜ ´ ` ¨ ^  ̄ _ 〇 "
  str = str & "― ‐ / \ ~ ∥ | … ‥ "
  str = str & "‘ ’ ( ) 〔 〕 [ "
  str = str & "] { } 〈 〉 《 》 「 」 "
  str = str & "『 』 【 】  ° ′ ″ "
  str = str & "! "" ' ( ) , - . / : ; ?"
  str = str & " " & Chr(&H8167) & " " & Chr(&H8168)
  Dim ar As Variant
  ar = Split(str)
  Dim i As Long
  For i = LBound(ar) To UBound(ar)
    If targetCharacter = ar(i) Then isSign = True: Exit Function
  Next
End Function
【参考】リスト4 標準モジュール
Private Sub changeFontColor(ByVal targetFont As Font)
  If isSign(targetFont.Parent.Text) Then _
    targetFont.ColorIndex = wdBlack: Exit Sub
  targetFont.ColorIndex = wdWhite
End Sub

使ってみる

f:id:akashi_keirin:20181020192841j:plain

この状態で、次のコードを実行。

リスト5 標準モジュール
Public Sub convertDocumentForTrainingPerSentence()
  Call changeColorFirstCharOfSentence(ThisDocument.Sentences)
End Sub

f:id:akashi_keirin:20181020193147j:plain

この通り。

ちなみに、上から5行目のカギ括弧の中の先頭の文字が白字になっているのは、直前の

「策に依ってはだが……?」

の直前が改段落ではなく、改行になっている上、特に文末であることを示す記号もつかわれていないせいだと思う。改段落なら、こんなことをしている間に、長安を潰滅してみせます」で一つのRangeオブジェクトと認識されるので、次の「策に依ってはだが……?」も一つのRangeオブジェクトと認識されるのだと思います。

f:id:akashi_keirin:20181020192813j:plain

おわりに

各文の先頭を印字するのがうるさいようなら、SentencesオブジェクトのところをParagraphsに変えて、段落先頭のみ印字、ということもできます。

Sentencesコレクションの要素の一番最初の「文字」が何文字目かを調べるFunction(Word)

Sentencesコレクションの要素の一番最初の「文字」が何文字目かを調べるFunction

分かりにくいタイトルですまぬ。

文の最初の文字の位置を調べたい。たとえば、

「……『ち~んw』とか言うな!」と言った。

みたいなときに、最初の文字「ち」の位置が知りたいということ。

考え方

次のように考えた。

  • Sententcesコレクションの要素(Rangeオブジェクト)を取得する。
  • RangeオブジェクトのCharactersコレクションを取得する。
  • Charactersコレクションの要素(String型の値)を一つづつisSignメソッドを用いて調べる。
  • isSignの返り値がFalseになったときのインデックスを返す。

こんな感じ。

コード

リスト1 標準モジュール
Private Function getFirstCharPosition( _
                   ByVal targetSentence As Range) As Long
  Dim ret As Long
  ret = 0
  Dim i As Long
  With targetSentence
    For i = 1 To .Characters.Count
      If Not isSign(.Characters(i)) Then ret = i: Exit For
    Next
  End With
  getFirstCharPosition = ret
End Function

短いコードなので、説明は省略……っていうか、上で書いた通りのことしかしていない。

参考に、isSignメソッドのコードを載っけておく。

【参考】リスト2 標準モジュール
Private Function isSign(ByVal targetCharacter As String) As Boolean
  isSign = False
  Dim str As String
  str = "、 。 , . ・ : ; ? ! "
  str = str & "゛ ゜ ´ ` ¨ ^  ̄ _ 〇 "
  str = str & "― ‐ / \ ~ ∥ | … ‥ "
  str = str & "‘ ’ ( ) 〔 〕 [ "
  str = str & "] { } 〈 〉 《 》 「 」 "
  str = str & "『 』 【 】  ° ′ ″ "
  str = str & "! "" ' ( ) , - . / : ; ?"
  str = str & " " & Chr(&H8167) & " " & Chr(&H8168)
  Dim ar As Variant
  ar = Split(str)
  Dim i As Long
  For i = LBound(ar) To UBound(ar)
    If targetCharacter = ar(i) Then isSign = True: Exit Function
  Next
End Function

使ってみる。

f:id:akashi_keirin:20181020085922j:plain

こんな風に、文章の一部を選択して、イミディエイト・ウインドウに、次のコードを書いて、それぞれ返り値を確かめる。

?Module1.getFirstCharPosition(Selection.Sentences(1))
?Module1.getFirstCharPosition(Selection.Sentences(2))
?Module1.getFirstCharPosition(Selection.Sentences(3))

ちなみに、選択部分の第1~3文は、それぞれ

  1. 「ここと長安の間は、長駆すれば十日で達する距離です。
  2. もしお許しあれば、秦嶺を越え、子午谷を渡り、虚を衝いて、敵を混乱に陥れ、彼の糧食を焼き払いましょう。
  3. ――丞相は斜谷から進まれ、咸陽へ伸びて出られたら、魏の夏侯楙などは、一鼓して破り得るものと信じますが」

この通り。

それぞれ、「2」、「1」、「3」が返ったら正解。

f:id:akashi_keirin:20181020085929j:plain

意図どおり。

おわりに

これで、準備完了。

記号は黒字、文字は白字にするマクロ

記号を黒字、文字を白字にする

前回

akashi-keirin.hatenablog.com

を用いて、記号は黒字に、文字は白字にするメソッドを作った。

コード

コードは次の通り。

リスト1 標準モジュール
Private Sub changeFontColor(ByVal targetFont As Font)    '……(1)'
  If isSign(targetFont.Parent.Text) Then _
    targetFont.ColorIndex = wdBlack: Exit Sub    '……(2)'
  targetFont.ColorIndex = wdWhite    '……(3)'
End Sub

(1)の

Private Sub changeFontColor(ByVal targetFont As Font)

で、引数としてFontオブジェクトを受け取るように設定。

(2)の

If isSign(targetFont.Parent.Text) Then _
  targetFont.ColorIndex = wdBlack: Exit Sub

下のリスト2に示すisSignメソッドには、String型の引数を渡さないといけないので、

targetFont.Parent.Text

と、一旦引数のFontオブジェクトのParentプロパティを参照してRangeオブジェクトを取得し、そのRangeオブジェクトのTextプロパティを参照することによってString型の値(つまり、文字列)を得ている。

isSignメソッドがTrueを返してきたときには、その文字列は記号だということなので、

targetFont.ColorIndex = wdBlack: Exit Sub

でフォントの色を黒にして、処理を抜ける。

isSignメソッドがFalseを返していたら、その文字列は記号でなく文字だということなので、(3)の

targetFont.ColorIndex = wdWhite

でフォントの色を白にして処理を抜けることになる。

【参考】リスト2 標準モジュール
Private Function isSign(ByVal targetCharacter As String) As Boolean
  isSign = False
  Dim str As String
  str = "、 。 , . ・ : ; ? ! "
  str = str & "゛ ゜ ´ ` ¨ ^  ̄ _ 〇 "
  str = str & "― ‐ / \ ~ ∥ | … ‥ "
  str = str & "‘ ’ ( ) 〔 〕 [ "
  str = str & "] { } 〈 〉 《 》 「 」 "
  str = str & "『 』 【 】  ° ′ ″ "
  str = str & "! "" ' ( ) , - . / : ; ?"
  str = str & " " & Chr(&H8167) & " " & Chr(&H8168)
  Dim ar As Variant
  ar = Split(str)
  Dim i As Long
  For i = LBound(ar) To UBound(ar)
    If targetCharacter = ar(i) Then isSign = True: Exit Function
  Next
End Function

実験

f:id:akashi_keirin:20181019214714j:plain

こんな文章を用意し、次のコードを実行する。

リスト3 標準モジュール
Public Sub test()
  Dim i As Long
  With ThisDocument.Paragraphs(4).Range
    For i = 2 To .Characters.Count
      Call changeFontColor(.Characters(i).Font)
    Next
  End With
End Sub

Paragraphsコレクションの4番目、上の画像で言うと、

孔明はうなずいた。その通りであると肯定しているものの如くである。そして彼は彼の考えどおり軍を進ませた。隴右の大路へ出でて正攻法を取ったものである。

の段落について、2文字目から最後まで、文字だったら白字、記号だったら黒字にするというコード。

これを実行すると、

f:id:akashi_keirin:20181019214722j:plain

こうなった。

おわりに

これで、また一歩、目的に近づいた。

文章の中で使われる記号かどうかを判定するFunction(Word)

文章の中で使われる記号かどうかを判定するFunction

ちょっとやってみたいことがあって、標題のようなFunctionを作ってみようと思い立った。

以前、

akashi-keirin.hatenablog.com

文字が漢字かどうかを判定するFunctionを作ったときは、ある意味非常に簡単だった。

文字コードが正の数かどうかで半角/全角の判定ができたし、漢字かどうかの判定も文字コードの大小で判定できた。

しかしながら、今度の場合、

f:id:akashi_keirin:20181019201818j:plain

コチラ(出典)を見ていただいてもお分かりの通り、文章の中で使う記号と見なしたいもの(カッコとかリーダとかダッシュの類)とそうでないものが入り組んでいるので、文字コードで判定する方式だと、非常に分かりにくいものになりそう。

考え方

あまり美しいやり方とは言えないかも知れないけれど、後々の加除訂正のしやすさを考えて、次のようにすることにした。

  • 文章の中で使われる記号と見なしたいものを列挙
  • それらをSplit関数の引数とし、記号をぶち込んだ配列を作る
  • 配列の各要素と照合し、一致した時点でTrueを返す

コーディング

次のように書いた。

リスト1 標準モジュール
Private Function isSign(ByVal targetCharacter As String) As Boolean
  isSign = False
  Dim str As String
  str = "、 。 , . ・ : ; ? ! "    '……(1)'
  str = str & "゛ ゜ ´ ` ¨ ^  ̄ _ 〇 "
  str = str & "― ‐ / \ ~ ∥ | … ‥ "
  str = str & "‘ ’ ( ) 〔 〕 [ "
  str = str & "] { } 〈 〉 《 》 「 」 "
  str = str & "『 』 【 】  ° ′ ″ "
  str = str & "! "" ' ( ) , - . / : ; ?"
  str = str & " " & Chr(&H8167) & " " & Chr(&H8168)    '……(2)'
  Dim ar As Variant
  ar = Split(str)
  Dim i As Long
  For i = LBound(ar) To UBound(ar)    '……(3)'
    If targetCharacter = ar(i) Then isSign = True: Exit Function
  Next
End Function

まず、(1)からの8行

str = "、 。 , . ・ : ; ? ! "
str = str & "゛ ゜ ´ ` ¨ ^  ̄ _ 〇 "
str = str & "― ‐ / \ ~ ∥ | … ‥ "
str = str & "‘ ’ ( ) 〔 〕 [ "
str = str & "] { } 〈 〉 《 》 「 」 "
str = str & "『 』 【 】  ° ′ ″ "
str = str & "! "" ' ( ) , - . / : ; ?"
str = str & " " & Chr(&H8167) & " " & Chr(&H8168)

は、Split関数の引数作り。

別に、1行で書いても良いのだけれど、見やすさを考慮してこのように複数回に分けて代入した。

以前

akashi-keirin.hatenablog.com

でも触れたように、Split関数では、第2引数を省略すると半角スペースがDelimiterと見なされるので、各記号の嵌張を半角スペースにしている。このテクニックを知っているのと知らないのとでは入力効率が大幅に変わると思う。id:t-homさん、ありがとぅー!

(2)の

str = str & " " & Chr(&H8167) & " " & Chr(&H8168)

は、

akashi-keirin.hatenablog.com

こいつを参照のこと。

VBEの余計なお世話対策です。

あとは、(3)からの3行

For i = LBound(ar) To UBound(ar)
  If targetCharacter = ar(i) Then isSign = True: Exit Function
Next

で、配列arにぶち込んだ記号を、引数targetCharacterと照合し、一致した時点でTrueを返すだけ。

一つも一致しなければForループを抜けることになるので、Falseが返る。

使ってみる

イミディエイトに、次のように打ち込んで、それぞれ[Enter]に中指を振り下ろす。

?ModuleMain.isSign("【")(全角の「」)

?ModuleMain.isSign(":")(半角の「:」)

?ModuleMain.isSign("ち")(全角の「」)

?ModuleMain.isSign("~")(全角の「」)

?ModuleMain.isSign("ん")(全角の「」)

?ModuleMain.isSign("w")(全角の「」)

f:id:akashi_keirin:20181019201830j:plain

おわりに

まあ、これだけだと「何に使うねん???」でしょうねえ。