下線（傍線）を施した部分のRangeオブジェクトを取得するFunction（Word）

下線（傍線）を施した部分のRangeオブジェクトを取得するFunction（Word）

なんとなく、役所広司ばりにチャチャっと作ってみた。

ソースコード

リスト１

Public Function GetNextUnderlinedRange( _
          Optional ByVal a_LineStyle As WdUnderline _
                         = wdUnderlineSingle) As Range
  Dim ret As Range
  Set ret = Nothing
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  With Selection.Find
    With .Font	               '……(1)'
      .Underline = a_LineStyle '……(2)'
      .StrikeThrough = False
      .DoubleStrikeThrough = False
      .Hidden = False
      .SmallCaps = False
      .AllCaps = False
      .Superscript = False
      .Subscript = False
    End With
    .Text = ""                 '……(3)'
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = True             '……(4)'
    .Highlight = False
    .MatchFuzzy = False '←注意！　こいつだけ初期値True'
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
  End With
  Call Selection.Find.Execute
  If Not Selection.Find.Found Then GoTo ReturnObject
  Set ret = Selection.Range
ReturnObject:
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  Set GetNextUnderlinedRange = ret
End Function

もう、大事なのは(1)の

With Selection.Find.Font
  .Underline = a_LineStyle '……(2)'
  .StrikeThrough = False
  .DoubleStrikeThrough = False
  .Hidden = False
  .SmallCaps = False
  .AllCaps = False
  .Superscript = False
  .Subscript = False
End With

だけと言っても過言ではない。（コードは省略を補完しています。）

FindオブジェクトのFontプロパティを参照して、Fontオブジェクトを取得し、そのUnderlineプロパティに値をセットしているだけ。

それが(2)の

Selection.Find.Font.Underline = a_LineStyle

です。（これまた省略を補完してあります。）

a_LineStyleは、このGetNextUnderlinedRangeメソッドが受け取る引数。WdUnderline型にしてある。

あとは、(3)の

Selection.Find.Text = ""

で、FindオブジェクトのTextプロパティを""に設定。これで、どんな文字列かに関係なく検索にヒットする。

ちなみに、(4)の

Selection.Find.Format = True

のところを、

Selection.Find.Format = False

にすると、わけのわからない箇所が検索に引っ掛かる。

原因は不明。

使ってみる

準備

次のような文書を用意して、先頭にカーソルを置き、

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

リスト２

Private Sub test01()
  Dim rng As Range
  Set rng = GetNextUnderlinedRange(wdUnderlineSingle)
  Debug.Print rng.Text
End Sub

一重下線の箇所を検索し、その部分の文字列をイミディエイトに出力するだけ、というコード。

実行結果

このとおり。一応意図どおりの結果が得られた。

おわりに

Findオブジェクトは、プロパティが多くてなかなかとっつきにくいが、こうやって一つづつ機能を試していくと、徐々にわかってくると思う。

おまけ

Findオブジェクトの各プロパティは、「検索と置換」ダイアログボックスの各部分との対応を確認していけば、理解が早いと思う。

おなじみ、［Ctrl］＋［ H ］を押したら出てくる「検索と置換」ダイアログボックス。

左下の「書式」ボタンをクリックし、「フォント」を選ぶと、「検索する文字」ダイアログボックスが出てくる。