Неверным путем идете. Давайте начнем с другого: зачем нужно возвращаться? Вероятно, производятся какие-то действия кодом, которые перемещают курсор. Какие это действия и как выглядит код?
К чему спрашиваю: большинство действий можно сделать без перемещения курсора, следовательно отпадет необходимость возвращать его.
возможно...
я находясь в любом месте документа запускаю с начала этого документа поиск и замену (в основном замена пробелов на безразрывные пробелы)
я тут подгрузил свой модуль - его задача поиск отдельных сочетаний в текстовом документе, и приводить к некоторым стандартам
ниже привожу в текстовом формате код.
Sub Макрос_подсчет(Find_Text As String, Color_Fon As Integer, Counter As Long)
Dim find_rng As Range, find As find
' Dim Counter As Long
'1. Откл. монитора.
Application.ScreenUpdating = False
'2. Создание объектов, которые будут искать.
Set find_rng = ActiveDocument.Range(0, 0)
Set find = find_rng.find
'3. Настройка поиска.
find.Text = Find_Text
find.Wrap = wdFindStop
'4. Поиск.
Do While find.Execute = True
'1) Закраска.
find_rng.HighlightColorIndex = Color_Fon
'2) Подсчёт, сколько найдено.
Counter = Counter + 1
'3) Превращение рейнджа в точку вставки и установка точки вставки после найденного фрагмента.
find_rng.Collapse Direction:=wdCollapseEnd
Loop
'5. Вкл. монитора.
Application.ScreenUpdating = True
'6. Сообщение.
' MsgBox "Найдено и закрашено: " & Counter, vbInformation
End Sub
Sub Procedure_1()
Dim myFindRange As Word.Range
Dim myFind As Word.find
'Создаём диапазон, в котором будем искать.
'ActiveDocument.Range - это основной текст в документе.
'Есть ещё колонтитулы, сноски и другое.
Set myFindRange = ActiveDocument.Range
'Создаём объект "Find" и даём ему имя "myFind".
Set myFind = myFindRange.find
'Указываем, какой текст ищем.
myFind.Text = "начальник"
'Флажок "Подстановочные знаки".
myFind.MatchWildcards = True
'Курсив является форматированием.
myFind.Format = True
' Selection.Range.HighlightColorIndex = wdYellow
myFind.Replacement.Font.ThemeColor = 2
'Указываем, что сделать с найденным текстом.
' myFind.Replacement.Font.Italic = True
'Производим поиск и замену.
myFind.Execute Replace:=wdReplaceAll
End Sub
Sub Проверить_пробелы_посленомера()
'
' Макрос6 Макрос
'
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = "№"
.Replacement.Text = "№^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = "^s "
.Replacement.Text = "^s"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute Replace:=wdReplaceAll
End Sub
Sub ReplaceMultiSpaces()
Dim oChar As Range
Dim kol As Integer
For Each oChar In ActiveDocument.Characters
If oChar.Text = " " Then
While oChar.Next(wdCharacter).Text = " "
oChar.Next(wdCharacter).Delete
kol = kol + 1
Wend
End If
Next
If kol > 0 Then MsgBox "Убрано пробелов = " & kol Else MsgBox "Дубликатов пробелов не обнаружено"
End Sub
Sub Zamena_probelov(Poisk As String, Bufer As Integer, kol As Integer)
Dim Finish As Boolean
' Макрос6 Макрос
Finish = True
Selection.GoTo 1, 1
Do While Finish
PozX = Selection.Information(wdFirstCharacterColumnNumber)
PozY = Selection.Information(wdFirstCharacterLineNumber)
Selection.find.ClearFormatting
With Selection.find
.Text = Poisk
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute
If Not (PozX = Selection.Information(wdFirstCharacterColumnNumber) And PozY = Selection.Information(wdFirstCharacterLineNumber)) Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=Bufer + 1
If Bufer > 0 Then Selection.TypeBackspace
Selection.TypeText Text:=" "
kol = kol + 1
Else
Finish = False
End If
Loop
End Sub
Sub Probel_nomer()
Dim kol1 As Integer
Dim kol2 As Integer
Application.ScreenUpdating = False
kol1 = 0
Zamena_probelov "№^$", 0, kol1
Zamena_probelov "№^#", 0, kol1
kol2 = 0
Zamena_probelov "№ ^$", 1, kol2
Zamena_probelov "№ ^#", 1, kol2
MsgBox "Всего в тексте найдено '№': " & kol2 & Chr(13) & " в т.ч. добавлено пробелов: " & kol1
Application.ScreenUpdating = True
End Sub
Sub Ubit_probel_data()
Dim kol As Integer
' убирает пробелы в датах (меняя на сцепленные)
kol = 0
'определение позиции
PozX = Selection.Information(wdFirstCharacterColumnNumber) ' позиция
PozY = Selection.Information(wdFirstCharacterLineNumber) ' строка
Page_ = Selection.Information(wdActiveEndPageNumber) ' страница
Application.ScreenUpdating = False
Zamena_probelov "^# январ", 1, kol
Zamena_probelov "^# феврал", 1, kol
Zamena_probelov "^# март", 1, kol
Zamena_probelov "^# апрел", 1, kol
Zamena_probelov "^# мая", 1, kol
Zamena_probelov "^# июня", 1, kol
Zamena_probelov "^# июля", 1, kol
Zamena_probelov "^# авгус", 1, kol
Zamena_probelov "^# сент", 1, kol
Zamena_probelov "^# октя", 1, kol
Zamena_probelov "^# нояб", 1, kol
Zamena_probelov "^# декаб", 1, kol
Zamena_probelov "20^#^# г.", 4, kol
MsgBox "Заменено пробелов в датах: " & kol
' возврат на позиции
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=Page_ ' страница
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=PozY ' строка
Application.ScreenUpdating = True
End Sub
Sub Ubit_probel_OOO()
Dim kol As Integer
Application.ScreenUpdating = False
PozY = Selection.Information(wdFirstCharacterLineNumber) ' строка
Page_ = Selection.Information(wdActiveEndPageNumber) ' страница
kol = 0
Zamena_probelov "ОАО ", 3, kol
If kol > 0 Then MsgBox "Заменено пробелов в 'ОАО': " & kol
kol = 0
Zamena_probelov "ООО ", 3, kol
If kol > 0 Then MsgBox "Заменено пробелов в 'ООО': " & kol
kol = 0
Zamena_probelov "ПАО ", 3, kol
If kol > 0 Then MsgBox "Заменено пробелов в 'ПАО': " & kol
kol = 0
Zamena_probelov " АО ", 3, kol
If kol > 0 Then MsgBox "Заменено пробелов в 'АО': " & kol
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=Page_ ' страница
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=PozY ' строка
Application.ScreenUpdating = True
End Sub