Поиск и замена в колонтитулах

[kuksha]

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

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

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

[arvitaly]

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

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

[kuksha]

Спасибо ОГРОМНОЕ! Заработало! А то у меня макрос-калека сейчас без этого...
У меня тоже 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 проходов, по словарю...) Может его для ускорения работы вынести в отдельный цикл? Ведь не всегда в документе есть колонтитулы... Как бы тогда проверку сделать на наличие колонтитулов в документе, прежде чем запускать цикл для колонтитулов?

[arvitaly]

Поищи пока ответ сам

[arvitaly]

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

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

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

[viter.alex]

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

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

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

[kuksha]

СПАСИБО всем, кто откликнулся!
Был занят, а сейчас вот руки дошли - буду разбираться и пробовать.

[kuksha]

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

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

[viter.alex]

Что значит искать в ссылках? В сносках, наверное?
Вот 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

[kuksha]

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

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

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

[viter.alex]

Я не поленился и заглянул в справку на тему 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

[Nickson]

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

Добрый день!

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

[Shurrik]

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

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

    ' 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