最近、中学生用の教材として漢字学習プリントを作っています。
そのときに、「下線部分を漢字にしなさい」というような問題になります。
- 同じドヒョウに立つ
- 豊臣秀吉のシソンにあたる
などなど。
ところが、これを実際に入力するのは結構手間なのです。
そもそも普段は漢字で入力する文字列をカタカナで入力するので、変換が面倒。
さらにそのカタカナ部分だけに下線を引くということ事態が面倒。
ショートカットキーの [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