Word 数字の1桁を全角に2桁以上を半角に
今日、とある日本から持ってきたはずのファイルを探していたら、昔作ったマクロにであった。
数字の一桁を全角に、二桁以上を半角にすると言うもの。有報等を紙で出していた時代に厳しくチェックするように言われていた時代があった。そのときに僕には目で対処しきれないと思って作成したもの。
目的が目的なので、「．」「，」には対応しているが、「/」やら「＋」やらには対応していない。契約書などで使う分にはとりあえず必要ないかと。その代わりといってはなんだが、変更箇所は履歴で表示してくれる。別名保存でクリーン版を作成し、それにこのマクロを適用すると、変更箇所にすぐにたどり着けると思う。
今の時代の人はいらないかもしれないが、契約書等で使う人もいるかもしれないと思い、開示する。
留学との絡みでは、留学前アソシには必要（？）で、留学中は全く不要のものといったところ。
ちなみに、ファイルは見つからずじまい・・・・
Sub ひとけた全角ふたけた半角()
Dim motorireki As String
'履歴を最少にするために回りくどい処理をしている
'変更履歴の記録開始
motorireki = ActiveDocument.TrackRevisions
If motorireki = False Then
ActiveDocument.TrackRevisions = True
End If
'全角数字等が続くものは半角にする
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[０-９．，.,]{2,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
Selection.Text = StrConv(Selection.Text, vbNarrow)
Selection.Collapse wdCollapseEnd
Loop
'４3のたぐいに対処
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[０-９][0-9]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
Selection.Text = StrConv(Selection.Text, vbNarrow)
Selection.Collapse wdCollapseEnd
Loop
'3４、のたぐいに対処
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[0-9][０-９]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
Selection.Text = StrConv(Selection.Text, vbNarrow)
Selection.Collapse wdCollapseEnd
Loop
'前後に半角数字等がつかない数字等を全角にする
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[!0-9.,][0-9][!0-9.,]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute = True
'先頭の一文字を選択範囲から外す
Selection.MoveStart unit:=wdCharacter, Count:=1
'最後の一文字を選択範囲から外す
Selection.MoveEnd unit:=wdCharacter, Count:=-1
'全角に変換
Selection.Text = StrConv(Selection.Text, vbWide)
Selection.Collapse wdCollapseEnd
Loop
'変更履歴記録を終了
If motorireki = False Then
ActiveDocument.TrackRevisions = False
End If
End Sub
