2017年04月25日

全角英数、半角カッコ、半角%を変更するWordマクロ

英日翻訳でよく実行する、全角英数を半角英数に、半角カッコを全角カッコに、半角%を全角%に変更する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 = "[0-9A-Za-z]{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
====ここまで=====
posted by 完治 at 08:25| Comment(0) | 日記 | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

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


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