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

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

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

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

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

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

Код ищет и удаляет в верхних и нижних колонтитулах в 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

I’m trying to make a macro in Excel which opens a Word document, find a especify text, which is inside of footer in word doc, and replace it for a text.

At the moment, my macro opens the word doc but I couldn’t figure out how to get into footer and find those texts.

    Dim objWord
    Dim objDoc
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Open(ThisWorkbook.Path & "/NotaPromissoriaAutomatica.docx")
    objWord.Visible = True

The footer have two texts which have to be replaced

1 — VAR_CIDADE > Which will be replaced the current city (which is in A1 of my excel table)
2 — VAR_DATA > Which will be replaced the current date (which is in A2 of my excel table)

I created a test document with a single page, header and footer, with the footer using the keyword «VAR_DATA». The example code below will search for all footers in the document and make the replacement. Notice that the code only searches in Section(1) though. If you have more sections, you may have to create an outer loop to search for each footer in every section.

Option Explicit

Public Sub FixMyFooter()
    Dim myWord As Object
    Dim myDoc As Word.Document
    Set myWord = CreateObject("Word.Application")
    Set myDoc = myWord.Documents.Open("C:Tempfootertest.docx")

    Dim footr As Word.HeaderFooter
    For Each footr In myDoc.Sections(1).Footers
        With footr.Range.Find
            .Text = "VAR_DATA"
            .Replacement.Text = Format(Now(), "dd-mmm-yyyy")
            .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindStop
        End With
    Next footr

    myDoc.Save
    myWord.Quit
End Sub

You’ll need to expand the example to find your additional text with your own formatting.

answered Apr 5, 2019 at 15:04