| |
随分と日が経ってしまいましたが・・・
Officeアシスタントをモードレスで起動して、
既に洋数字に置き換えられたものをワイルドカードで検索して、
黄色の蛍光ペン書式にするということで考えました。
下記のマクロを起動し、
[蛍光ペン書式 設定]をクリックして下さい。
洋数字の部分が、黄色の蛍光ペン書式になります。
その後、[蛍光ペン書式 検索]をクリックして、順次確認できますが、
漢数字に戻したい場合は、この検索で文字列が選択された状態で、
スペースキーを押すと、変換候補が表示されるので、
スペースキーを数回押して、変換候補を選択し、
[蛍光ペン書式 検索]を押して下さい。
（次の蛍光ペン書式の文字列を検索します。
この時、変換確定のための実行キーを押す必要はありません。）
[蛍光ペン書式 解除]は、蛍光ペン書式を全部解除します。
尚、Officeアシスタントは五者択一ですが、
[3][4]の処理は作っておりません。
私の環境はWord2002・IME2002です。
私が調べた範囲では、
2000でも同様にできると思うのですが・・・
Sub 洋数字検索()
Rem 洋数字検索処理
Rem 言語：Word VBA
Rem 機能：洋数字を検索して、蛍光ペン書式を設定する処理
Rem 注記：洋数字検索を起動して使用｡
Rem 第1版：2004/06/20：作成。
Rem *----*----* *----*----* *----*----* *----*----*
Assistant.Visible = True
'
With Assistant.NewBalloon
.Animation = msoAnimationIdle
.BalloonType = msoBalloonTypeButtons
.Icon = msoIconAlertQuery
.Button = msoButtonSetCancel
.Heading = vbCr & "洋数字 検索処理"
.Text = "選択して下さい。"
.Labels(1).Text = "蛍光ペン書式 設定"
.Labels(2).Text = "蛍光ペン書式 検索"
.Labels(3).Text = "====="
.Labels(4).Text = "====="
.Labels(5).Text = "蛍光ペン書式 解除"
.Mode = msoModeModeless
.Callback = "洋数字検索Exec"
.Show
End With
End Sub ' 洋数字検索 *----*----* *----*----* *----*----* *----*----*
Sub 洋数字検索Exec(blln As Balloon, bttn As Long, bllnID As Long)
Dim myStartMarker As Word.Range
Dim myResult As Integer
'
If bttn = -2 Then ' [キャンセル]ボタン時
blln.Close
Assistant.Visible = False
Exit Sub
End If
'
Select Case bttn
Case 1
Selection.HomeKey Unit:=wdStory
Set myStartMarker = Selection.Range
'
Rem １桁以上の洋数字を検索。
With Selection.Find
.ClearFormatting
.Text = "[0-9]{1,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
'
Do While Selection.Find.Execute
Selection.Range.HighlightColorIndex = wdYellow
Loop
Selection.Collapse wdCollapseEnd
myStartMarker.Select ' 検索後、開始点に戻る。
'
Rem 桁区切りカンマ・小数点付き洋数字を検索
With Selection.Find
.ClearFormatting
.Text = "[0-9,.]{3,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
'
Do While Selection.Find.Execute
Selection.Range.HighlightColorIndex = wdYellow
Loop
'
Selection.Collapse wdCollapseEnd
myStartMarker.Select ' 検索後、開始点に戻る。
Assistant.Animation = msoAnimationCharacterSuccessMajor
' *====*====*====*====*
Case 2
With Selection.Find
.ClearFormatting
.Text = ""
.Highlight = True ' 蛍光ペン書式を検索することを指定
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute
End With
'
Assistant.Animation = msoAnimationGestureRight
' *====*====*====*====*
Case 3
Rem 何も処理しない。
' *====*====*====*====*
Case 4
Rem 何も処理しない。
' *====*====*====*====*
Case 5
myResult = MsgBox("蛍光ペン書式を" & "解除しますか？", vbExclamation + vbOKCancel, "洋数字検索")
If myResult = vbCancel Then
If Tasks.Exists(Name:="Microsoft Word") = True Then
Tasks("Microsoft Word").Activate
End If
Exit Sub
End If
'
Set myStartMarker = Selection.Range
Selection.Words(1).Select
Selection.Collapse wdCollapseStart
'
With Selection.Find
.ClearFormatting
.Highlight = True ' 蛍光ペン書式を検索することを指定
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
End With
'
Do While Selection.Find.Execute
With Selection.Range
.HighlightColorIndex = wdNoHighlight
End With
Selection.Collapse wdCollapseEnd
Loop
'
myStartMarker.Select ' 検索後、開始点に戻る。
Assistant.Animation = msoAnimationCharacterSuccessMajor
End Select
'
If Tasks.Exists(Name:="Microsoft Word") = True Then
Tasks("Microsoft Word").Activate
End If
End Sub ' 洋数字検索Exec *----*----* *----*----* *----*----*
|
|
H. C. Shinopy
- 04/6/21(月) 0:00 -
