| |
ちょっと修正します。
洋数字中に桁区切りカンマや小数点があることを考えて、
その時は数字が３つは並んでいるだろうという考え方をしたのですが、
ここでは、単に数字の間に「,」「.」があれば、
黄色蛍光ペン書式にするということでよいと思います。
「桁区切りカンマ・小数点付き洋数字を検索」の部分の「.Text = "[0-9,.]{3,}"」を
「.Text = "[0-9][,.]{1,1}[0-9]"」に修正します。
従って、マクロは下記の通り。
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][,.]{1,1}[0-9]"
.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(月) 22:23 -
