| |
残念ながら簡単には行かないようです。
選択範囲の文字の位置を取り込んで、
Ifステートメントで範囲内かどうか判断しながら処理する方法はありますが、
どうしても範囲外の文字列を検索してしまいますし、
Ifステートメントが悪さをするのか下記の「二重検索」マクロより処理時間が長くなります。
私の場合は、まず正規表現で検索して、
再びFindで検索してカーソルを移動させ書き換えする方法でやっています。
（正規表現のメタキャラクタ（\|()[]{}^$*+?.など）に該当する文字列を検索する場合は、
その前に「\」を付ける必要があるので注意！）
下記のマクロは選択した範囲内の文字列で、
例えば「cx」（あるいは「c^」）・「a_」を検索して、
各々「^」の付いたc、「^」の付いたaに置換する処理です。
また、位置については下記マクロの
Dim myRangeStart As Word.Range
…
Set myRangeStart = Selection.Range ' 検索開始点を取得する。
…
myRangeStart.Select ' 検索開始点に戻る。
を見て下さい。
以下、マクロ。
Sub MyFindReplace()
Rem *----*----* *----*----* *----*----* *----*----*
Rem 選択範囲内 文字列検索置換処理
Rem 作譜：Hitrock Camellia Shinopy
Rem 言語：Word VBA
Rem 機能...
Rem 1. 選択した範囲内で、指定した文字列を検索し置換する。
Rem 注記...
Rem 1. 正規表現で検索した文字列を再度Selection.Findプロパティで検索。
Rem 2.
Rem 履歴...
Rem 第01版：2010/09/30：作成。
Rem *----*----* *----*----* *----*----* *----*----*
Dim myRegExp As Object ' VBScript_RegExp_55.RegExp
Dim myMatches As Object ' MatchCollection
Dim myMatch As Object ' Match
Dim myTextReplace As String
'
Dim myRangeStart As Word.Range
'
Dim i As Long
Dim c As Long
Dim myStatusBar As String
Rem *----*----* *----*----* *----*----* *----*----*
'
If Len(Selection.Range.Text) <= 0 Then
Rem 範囲を指定しなかった場合は、カーソルより後で文書の末尾まで選択する。
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
End If
'
Set myRegExp = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp
Rem *----*----* *----*----* *----*----* *----*----*
'
MyFindReplaceSubEntry:
With myRegExp
.Pattern = "[cghjsu][x\^]|[aeiou]_" ' パターンを設定
.IgnoreCase = False ' 大文字と小文字を区別する
.Global = True ' 文字列全体を検索
'
If .Test(Selection.Range.Text) = False Then
MsgBox "該当する文字列がありません。"
Selection.Collapse wdCollapseStart
GoTo MyFindReplaceSubExit
End If
'
i = 0
Set myMatches = .Execute(Selection.Range.Text)
Selection.Collapse wdCollapseStart
Set myRangeStart = Selection.Range ' 検索開始点を取得する。
'
For Each myMatch In myMatches
With Selection.Find
.Text = myMatch.Value
.Execute
End With
'
Select Case myMatch.Value
Case "cx": myTextReplace = ChrW(265)
Case "c^": myTextReplace = ChrW(265)
Case "a_": myTextReplace = ChrW(226)
End Select
'
Selection.TypeText myTextReplace ' 置き換え。
'
i = i + 1
c = i * 100 \ myMatches.Count
myStatusBar = Format(c, "##0") & "% " & i & "/" & myMatches.Count & "件"
Application.StatusBar = "MyFindReplace" & "：処理中" & " " & myStatusBar
DoEvents
Next ' myMatch
End With
'
myRangeStart.Select ' 検索開始点に戻る。
Rem *----*----* *----*----* *----*----* *----*----*
'
MyFindReplaceSubExit:
Set myRegExp = Nothing
Set myMatches = Nothing
Set myRangeStart = Nothing
Application.StatusBar = "MyFindReplace" & "：" & "処理完了！"
End Sub ' MyFindReplace *----*----* *----*----* *----*----* *----*----*
[End]
|
|
![[未読]](./data/word/image/read_icon.gif){kind=icon}
