【コード】直前のカタカナに下線を引く

最近、中学生用の教材として漢字学習プリントを作っています。

そのときに、「下線部分を漢字にしなさい」というような問題になります。

  • 同じドヒョウに立つ
  • 豊臣秀吉のシソンにあたる

などなど。

ところが、これを実際に入力するのは結構手間なのです。

そもそも普段は漢字で入力する文字列をカタカナで入力するので、変換が面倒。

さらにそのカタカナ部分だけに下線を引くということ事態が面倒。

ショートカットキーの [Ctrl] + [U] で一重下線のオン・オフを設定できますけど、どうにも面倒なのです。

そこで、こんなマクロを作ってしまいました。

このマクロでできること

カーソル位置(|で示しました)の上流側にあるカタカナの語句に下線を引きます。

(マクロ実行前)

同じドヒョウに立|

(マクロ実行後)

同じドヒョウに立|

マクロ解説

MoveStartWhile メソッドやMoveEndWhile メソッドを使わずに、1文字ずつ判定しながら処理をしています。

Like演算子を用いて、カタカナを判定しています。

マクロ


Sub カーソル手前のカタカナに下線を引く()

 Dim myRange As Range
 Dim myChr As String

 Set myRange = Selection.Range
 myChr = "[ァ-ヾ]"

 '開始位置の設定
 Do While Not myRange.Characters.First.Previous Like myChr
  With myRange
   .Start = .Start - 1
  End With
 Loop

 Do While myRange.Characters.First.Previous Like myChr
  With myRange
   .Start = .Start - 1
  End With
 Loop

 '終了位置の設定
 Do While Not myRange.Characters.Last Like myChr
  With myRange
   .End = .End - 1
  End With
 Loop

 myRange.Font.Underline = wdUnderlineSingle

 Set myRange = Nothing

End Sub

トップへ戻る