Замена текста в колонтитулах word vba

i wanted to replace a text in the footer of word doc. Some docs might have only primary header and footer, some have multiple headers and footers.

Here’s my code:

Sub changedate()

     Selection.HomeKey Unit:=wdStory
     ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter    

Check1:
     With Selection.Find
        .Text = "Dec 01, 2015"
        .Replacement.Text = "Dec 01, 2015"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

      ActiveWindow.ActivePane.View.NextHeaderFooter
    On Error GoTo Cont
         GoTo Check1


Cont:
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


End Sub

On multiple footer documents it works fine, but if only one footer is available it shows an error.

Запускаю автозапись макросов, ввожу условия для поиска и замены через стандартное меню ворда. Слова успешно заменяются и в основном тексте и в колонтитулах.
Запускаю отдельно полученный макрос — слова заменяются только в основном тексте, в колонтитулах замена не происходит…

Пробовал в условиях поиска задавать отдельно стили — верхний и нижний колонтитулы (там можно только поотдельности). Тоже отрабатывает как надо, но макросы которые получаются опять с колонтитулами не работают…

Как производить поиск и замену в колонтитулах?

Покажи код макроса и версию офиса.

Код ищет и удаляет в верхних и нижних колонтитулах в Word 2003

Код: Выделить всё

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "gggg"
        .Replacement.Text = "aaaa"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "gggg"
        .Replacement.Text = "aaaa"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Спасибо ОГРОМНОЕ! Заработало! А то у меня макрос-калека сейчас без этого…
У меня тоже 2003, и при выборе верхнего колонтитула в стилях в окне поиска-замены, автозаписывался вот такой код:

Код: Выделить всё

    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Верхний колонтитул")
    Selection.Find.ParagraphFormat.Borders.Shadow = False
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "ааа"
        .Replacement.Text = "ооо"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Кстати, если у меня этот код будет в цикле стоять, то точно замедление работы будет(около 8000 проходов, по словарю…) Может его для ускорения работы вынести в отдельный цикл? Ведь не всегда в документе есть колонтитулы… Как бы тогда проверку сделать на наличие колонтитулов в документе, прежде чем запускать цикл для колонтитулов?

Набросал функцию вроде должна работать

Код: Выделить всё

Function isHColon(paneState As String) As Boolean
    ActiveWindow.ActivePane.View.SeekView = paneState
     Selection.ClearFormatting
    If Selection.Words.Count > 0 Then
        If Selection.Words(1) <> "" And Asc(Selection.Words(1)) <> 13 Then
            isHColon = True
        Else
            isHColon = False
        End If
    Else
        isHColon = False
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

    End Function
Sub RUN_THIS()
    MsgBox isHColon(wdSeekCurrentPageHeader)
End Sub

Может быть автору темы понадобится мой вариант. Если работать с окном нет возможности (приложение не видно), то можно искать в колонтитулах другим способом. Сделал на скорую руку, но при необходимости можно усложнить и расширить.

Код: Выделить всё

Sub SearchInHeadersFooters()
  Dim oHeadFtr As HeaderFooter, oSec As Section
  For Each oSec In ActiveDocument.Sections
    'Поиск в верхних колонтитулах
    For Each oHeadFtr In ActiveDocument.Sections(1).Headers
      If SearchInRange(oHeadFtr.Range) Then MsgBox "Нашёл!"
    Next
    'Поиск в нижних колонтитулах
    For Each oHeadFtr In ActiveDocument.Sections(1).Footers
      If SearchInRange(oHeadFtr.Range) Then MsgBox "Нашёл!"
    Next
  Next
End Sub
Function SearchInRange(oRng As Range) As Boolean
  With oRng.Find
    .Text = "верхний колонтитул"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    SearchInRange = .Execute
  End With
End Function

Всем спасибо. Получилось:
сначала прогон по основному содержимому документа,
потом переключение на верхний колонтитул wdSeekCurrentPageHeader , опять прогон
потом прогон по нижнему колонтитулу wdSeekCurrentPageFooter .
учитывая, что в цикле более 8000 проходов, времени тратится довольно много.

Вот сейчас ещё оказалось, что поиск/замена в ссылках тоже не срабатывает, как в колонтитулах раньше.
2 вопроса:
1) как искать в ссылках? (справка о WdSeekView у меня запорчена, если речь о ней — вижу дюжину WdSeek* и не могу прочесть что есть что…)
2) нельзя ли как-то объединить все эти прогоны? (если окажется, что в идеале нужно прогонять по всем WdSeek*, то… сколько же это времени займёт!)

Что значит искать в ссылках? В сносках, наверное?
Вот WdSeekView Enumeration

Код: Выделить всё

wdSeekCurrentPageFooter 10 The current page footer.
wdSeekCurrentPageHeader 9 The current page header.
wdSeekEndnotes 8 Endnotes.
wdSeekEvenPagesFooter 6 The even pages footer.
wdSeekEvenPagesHeader 3 The even pages header.
wdSeekFirstPageFooter 5 The first page footer.
wdSeekFirstPageHeader 2 The first page header.
wdSeekFootnotes 7 Footnotes.
wdSeekMainDocument 0 The main document.
wdSeekPrimaryFooter 4 The primary footer.
wdSeekPrimaryHeader 1 The primary header.


Кстати, так это дело можно и объединить, запусти цикл от 1 до 10, а затем в цикле меняй

Код: Выделить всё

For i=1 to 10
  ActiveWindow.ActivePane.View.SeekView = i
Next i

Спасибо, теперь вижу что есть что
Да, конечно я сноски имел ввиду, оговорился.
Пока в лоб сделаю, чтобы работало.

Насчёт вложенного цикла по перебору wdSeek* ВНУТРИ КАЖДОГО прохода основного цикла (в котором 8000 проходов) — получим 88000 проходов!

Я вообще-то имел ввиду оставить 8000, но наверное это единственный путь…

Я не поленился и заглянул в справку на тему StoryRanges Collection Object. Там приведен пример, который полностью, как мне кажется, соответствует твоим запросам.

Тебе нужно искать что-то в разных структурных элементах документа: сносках, концевых сносках, колонтитулах и пр. Все эти структурные элементы, если они есть в документе, являются элементами коллекции StoryRanges. Задача состоит в том, чтобы искать в каждом из этих элементов.

То, что ты делаешь сейчас, это переключение между разными видами (переход по этим структурным элементам на экране) и поиск в Selection. Это не есть гуд. Чтобы получить элемент из документа в 99% случаев выбирать на экране его не нужно. К нему можно обратиться напрямую через объектную модель документа.

Вот немного измененный пример из справки. В нем перебираются все такие структурные элементы, которые есть в документе и в них ведется поиск. Этот метод будет работать пошустрее твоего с переключением видов, хотя бы потому, что не будет мелькат экран. Если не будет работать, пиши, разберемся.

Код: Выделить всё

Sub FindInStories()
  Dim myStoryRange As Range
  For Each myStoryRange In ActiveDocument.StoryRanges
    With myStoryRange
      With .Find
        .Text = "ааа"
        .Replacement.Text = "ооо"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
      While Not (.NextStoryRange Is Nothing)
        Set myStoryRange = .NextStoryRange
        With .Find
          .Text = "ааа"
          .Replacement.Text = "ооо"
          .Forward = True
          .Wrap = wdFindContinue
          .Format = True
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
          .Execute Replace:=wdReplaceAll
        End With
      Wend
    End With
  Next myStoryRange
End Sub

Re: Поиск и замена в колонтитулах
viter.alex » 23.06.2009 (Вт) 20:35

Добрый день!

Почему-то у меня этот пример не работает в цикле с разными именами файлов. Первый раз работает а потом нет. Среда VB6. Не подскажете, как правильно открывать, закрывать в данном случае файлы, может, какие-то объекты надо очищать. Спасибо.

Несколко лет назад тоже споткнулся об эти грабли, мне надо было заменять тект в надписях.
Пашел пример, уже не помню где, в котором замена происходит везде.
Теперь просто вставляю в программу функцию и пользуюсь.

Код: Выделить всё

    ' WORD (WO) находит текст (p) и меняет его на (t)
    ' Dim WO As Object = CreateObject("Excel.Application")

    Private Sub ZamText(ByVal WO As Object, ByVal p As String, ByVal t As String)
        Dim Story As Object
        For Each Story In WO.Selection.Document.StoryRanges
            Do
                With Story.Find
                    .Text = p : .Replacement.Text = t
                    .Wrap = 1 : .Execute(Replace:=2)
                End With
                Story = Story.NextStoryRange
            Loop While Not Story Is Nothing
        Next
    End Sub

12   голосов , оценка 3.833 из 5