Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.04.2017, 20:06   #11
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

так я не понял, что это часть макроса замены - вот оно:
Код:
Sub frepl30(chto, chem)
Dim z1, z1k
z1 = chto
z1k = chem
Options.AutoFormatAsYouTypeReplaceQuotes = False
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find
  .Text = z1
  .Replacement.Text = z1k
  .Forward = True
  .Wrap = wdFindContinue
  .MatchWildcards = False
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 ActiveWindow.ActivePane.VerticalPercentScrolled = 0
 Dim sn1 As Footnote, s1
 For Each sn1 In Word.ActiveDocument.Footnotes
 s1 = Replace(sn1.Range.Text, z1, z1k, , , vbTextCompare)
 sn1.Range.Text = s1
 Next sn1
 Dim sn2 As Endnote, s2
 For Each sn2 In Word.ActiveDocument.Endnotes
 s1 = Replace(sn2.Range.Text, z1, z1k, , , vbTextCompare)
 sn2.Range.Text = s1
 Next sn2
Options.AutoFormatAsYouTypeReplaceQuotes = True
End Sub
caute вне форума Ответить с цитированием
Старый 25.04.2017, 06:43   #12
Вождь
Форумчанин
 
Аватар для Вождь
 
Регистрация: 29.09.2008
Сообщений: 378
По умолчанию

Цитата:
Сообщение от caute Посмотреть сообщение
так я не понял...
Тогда, обязательно напишите, что вы хотите, что бы этот макрос делал?
Раз уж вы не в курсе, что он делает вообще

Вот, например, переделал его, как я понял:
Код:
Sub frepl30(ByVal TextFind As String, ByVal TextReplace As String)
' поиск и замена текста во всем документе и во всех сносках
' TextFind, TextReplace - вход: значения найти и заменить, поиска без подстановочных знаков
Dim B As Boolean
    B = Options.AutoFormatAsYouTypeReplaceQuotes
    Options.AutoFormatAsYouTypeReplaceQuotes = False
    ' документ
Dim R As Range
    Set R = ActiveDocument.Range
    GoSub sub_Replace
    ' сноски
 Dim F As Footnote
    For Each F In ActiveDocument.Footnotes
        Set R = F.Range
        GoSub sub_Replace
    Next F
    ' концевые
 Dim E As Endnote
    For Each E In ActiveDocument.Endnotes
        Set R = E.Range
        GoSub sub_Replace
    Next E
    '
    Options.AutoFormatAsYouTypeReplaceQuotes = B
    Exit Sub
    ' замена в области R
sub_Replace:
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = False
        .Text = TextFind
        .Replacement.Text = TextReplace
        .Execute Replace:=wdReplaceAll
    End With
    Return
End Sub
Макросы на заказ и готовый пакет - http://mtdmacro.ru/
Вождь вне форума Ответить с цитированием
Старый 25.04.2017, 17:26   #13
caute
Форумчанин
 
Регистрация: 27.10.2009
Сообщений: 277
По умолчанию

спасибо, заработало как часы!
удобное решение, на самом деле: добавлять цепочки замен в максимально компактном виде с отсылкой к frepl30

Последний раз редактировалось caute; 25.04.2017 в 17:45.
caute вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос для замены русских букв на греческие voevodik Microsoft Office Word 2 21.05.2016 11:08
Макрос для замены содержимого ссылок AleksP Microsoft Office Word 1 12.12.2014 04:06
Макрос для замены текста Georgetta Microsoft Office Word 8 05.08.2011 12:00
макрос для замены кавычек caute Microsoft Office Word 10 23.05.2011 00:41
Макрос для поиска/замены Davidoff Microsoft Office Excel 1 20.01.2007 16:01