英日翻訳でよく実行する、全角英数を半角英数に、半角カッコを全角カッコに、半角%を全角％に変更するWordマクロ。
実際に使ってみて、この3つの作業をすべて行うと支障が出るケースもあるので、全角英数と半角カッコだけ、全角英数と半角%だけ、全角英数だけも選べるようにした。
変更した箇所は黄色でハイライトされ、変更した箇所数も表示されるので、どこが変更されたか、やらんでもいい変更がされていないか確認できる。
＝＝＝＝＝ここから＝＝＝＝
'
'全角英数字から半角英数字へ、半角カッコか全角カッコへ、半角%から全角％の変更を、インプットで選んで行い、変換箇所を黄色でハイライトし、変更箇所数をメッセージで出す
Dim myRange As Range
Dim changeNumber As Integer
Dim varNumber As Variant
Dim messageContents As String
'作業内容を選択する
Do
varNumber = InputBox("変換する文字種の番号を入力してください" & vbCr _
& "1：全角英数字、半角カッコ、半角%" & vbCr _
& "2：全角英数字、半角カッコ" & vbCr _
& "3：全角英数、半角%" & vbCr _
& "4：全角英数のみ")
If varNumber > 0 And varNumber <= 4 Then Exit Do
'入力された内容が不適切な場合はメニューを再表示
Loop
'変更箇所を数える変数を0にする。
changeNumber = 0
Set myRange = ActiveDocument.Range(0, 0)
'全角英数を探して半角に変更
With myRange.Find
.Text = "[０-９Ａ-Ｚａ-ｚ]{1,}"
.MatchWildcards = True
Do While .Execute = True
myRange.CharacterWidth = wdWidthHalfWidth
myRange.HighlightColorIndex = wdYellow
myRange.Collapse wdCollapseEnd
changeNumber = changeNumber + 1
Loop
End With
'全角英数のみの場合、これ以降の変更を行わずに終了
If varNumber = 4 Then GoTo Line1
'全角英数と％の場合、半角カッコの変更を行わずにLine2へ飛ぶ
If varNumber = 3 Then GoTo Line2
Set myRange = ActiveDocument.Range(0, 0)
'半角のカッコを全角に変更
With myRange.Find
.Text = "[)(]{1,}"
.MatchByte = True
.MatchWildcards = True
Do While .Execute = True
myRange.CharacterWidth = wdWidthFullWidth
myRange.HighlightColorIndex = wdYellow
myRange.Collapse wdCollapseEnd
changeNumber = changeNumber + 1
Loop
End With
Line2:
'全角英数と半角カッコのみの場合、以下の変更を行わずに終了
If varNumber = 2 Then GoTo Line1
Set myRange = ActiveDocument.Range(0, 0)
'半角の%を全角の％に変更
With myRange.Find
.Text = "%"
.MatchByte = True
.MatchWildcards = True
Do While .Execute = True
myRange.CharacterWidth = wdWidthFullWidth
myRange.HighlightColorIndex = wdYellow
myRange.Collapse wdCollapseEnd
changeNumber = changeNumber + 1
Loop
End With
Selection.Find.Execute Replace:=wdReplaceAll
Line1:
Set myRange = Nothing
'変更した箇所の数をメッセージで表示
'変更箇所がない場合
If changeNumber = 0 Then
MsgBox "変更箇所はありませんでした"
Else
'選択に応じた作業内容をメッセージに反映
Select Case varNumber
Case 1
messageContents = "全角英数、半角カッコ、半角%"
Case 2
messageContents = "全角英数と半角カッコ"
CAse 3
messageContents = "全角閣英数と半角%"
Caes 4
messageContents = "全角英数"
End Select
MsgBox messageContents & "の変更は" & changeNumber & "カ所でした"
End If
＝＝＝＝ここまで＝＝＝＝＝
