【Word VBA】直前のカタカナに下線を引く

2016年7月11日

, ,

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

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

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

などなど。

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

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

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

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

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

このマクロでできること

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

（マクロ実行前）

同じドヒョウに立|つ

（マクロ実行後）

同じドヒョウに立|つ

マクロ解説

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

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

マクロ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
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

-コード
-, ,

S