2016年10月25日

Wordの丸数字1から50までを検索してハイライトするマクロ

先日、Wordの丸数字1から35までを検索してハイライトするマクロを作ったのだけれど、今日、40まで検索してハイライトする必要性ができたので、36から50の部分を新たに追加。
スマートじゃなくて、ゴリゴリやるマクロなので、美しい書き方があったら、教えてください。

=====ここからマクロ====

'
'丸数字をハイライトするためのマクロ
'
'
'ユニコードの入れ物の定義
Dim Word1 As Long

'
'スピードを上げるため画面更新を停止
Application.ScreenUpdating = False

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

'丸数字(@〜S)を検索して黄色ハイライト
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[@-S]"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchByte = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With

'丸数字の21から35を検索して黄色ハイライト
'最初に検索する丸数字21のユニコード
Word1 = &H3251&

'丸数字35まで繰り返すループ
Do While Word1 < &H3261&

Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(Word1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With
'次に検索すべき丸数字のユニコード
Word1 = Word1 + 1
Loop


'丸数字の36から50を検索して黄色ハイライト
'最初の丸数字36のユニコード
Word1 = &H32B1&
'50までループ
Do While Word1 < &H32C0&

Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ChrW(Word1)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
Do While .Execute = True
With Selection
.Range.HighlightColorIndex = wdYellow
.Collapse direction:=wdCollapseEnd
End With
Loop
End With
'次に検索すべき丸数字のユニコード
Word1 = Word1 + 1
Loop

'画面の更新を再開
Application.ScreenUpdating = True

'カーソルをページ先頭に移動
Selection.HomeKey unit:=wdStory

=====ここまでマクロ====
posted by 完治 at 16:35| Comment(0) | 日記 | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。