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

[Sancred]

Добрый день, уважаемые форумчане.
Такой вопрос. Написал функцию по замене кода в скобочках [код] на текст в колонтитуле,но почему-то происходит не полная замена кода на значение. Помогите пожалуйста разобраться.

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

Sub ups()
Dim oHeadFtr As HeaderFooter, oSec As Section
  For Each oSec In ActiveDocument.Sections
    'Поиск в верхних колонтитулах
    For Each oHeadFtr In ActiveDocument.Sections(1).Headers
    Call SearchInRange(oHeadFtr.Range)
    Next
    'Поиск в нижних колонтитулах
    For Each oHeadFtr In ActiveDocument.Sections(1).Footers
   Call SearchInRange(oHeadFtr.Range)
    Next
  Next
End Sub
Function SearchInRange(oRng) As Boolean
  With oRng.Find
        .Text = "[[]?*[]]"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute
Do While .Found = True
    .Execute
   With oRng.Find
        .Text = oRng
        .Replacement.Text = "Дыня"
        .Forward = True
        .Format = False
        .Execute Replace:=wdReplaceAll
    End With
Loop
End With
End Function



[ark]

Не понял, а цикл зачем? Может, так было задумано:

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

Function SearchInRange(oRng) As Boolean
  With oRng.Find
        .Text = "[[]?*[]]"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Replacement.Text = "Дыня"
        .Execute Replace:=wdReplaceAll
    End With
End Function

[Sancred]

Это только часть, будет несколько кодов в скобках, которые нужно будет последовательно заменить в колонтитуле

[ark]

Все на дыню? Приведённый код это и делает.Или зависит от того, что в скобках?

[Sancred]

В зависимости от кода берет значение из экселевского документа.

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

[ark]

Ну, если шаблонов конечное множество

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

For Each strFind In FindTemplates
     strReplace=GetReplacementFromExcel(strFind) 'эту функцию можно и в DoReplace поместить, тогда одним аргументом меньше будет
     DoReplace rng,strFind,strReplace,True
Next
Function DoReplace(oRng,strFind As String,strReplace As String, bWildCards as Boolean) As Boolean
  With oRng.Find
        .Text = strFind
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = bWildCards
        .Replacement.Text = strReplace
        .Execute Replace:=wdReplaceAll
    End With
End Function

[Sancred]

Ark, не могли бы ли Вы подсказать, можно ли организовать в функции поиск значений strFind и strReplace? Или нужно будет обязательно передавать эти значения в фунцкию?
Просто поиск кода пытаюсь реализовать в функции. Я не могу передать значение из макроса какой код и на что заменять, так как неизвестно какие коды есть в колонтилуе.
Все спасибо, разобрался, реализовал двумя функциями.

[ark]

Я бы вообще сперва инициализировал строки поиска/замены. Для этого удобно воспользоваться объектом Dictionary из Microsoft Scripting Runtime, где ключ - строка поиска, а значение - строка замены:

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

'Подключить Microsoft Scripting Runtime в References
Dim bInit As Boolean
Dim dict As Dictionary
Sub InitFindReplace()
    If bInit Then exit Sub 'выполняется только 1 раз
    Set dict=New Dictionary
    dim findTemplates
    findTemplates=Array("[foo]","[bar]","[blah]")
    For Each sFind In findTemplates
        dict.Add(sFind,GetReplaveTextFromExcel(sFind))
        'Или можно сразу из Excel'я все sFind и sReplace взять, прочитав соответствующий Range
    Next
End Sub

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

Sub YourMacro()
'.........
InitFindReplace
For Each s In dict.Keys
     DoReplace rng,s,dict(s),True
Next
End Sub

[Qwertiy]

Что-то как-то неэффективно...