Подстановка в колонтитулы документов сложной структуры

[EducatedFool]

Приветствую, коллеги

Не получается выполнить замены по всему документу Word, если он сложный (колонтитулы с надписями, несколько Sections) при выполнении макроса из Excel
Не выполняется замена внутри колонтитула на 3 и 4 страницах (где в рамке документа присутствует текст в виде надписей)

Макрос рабочий, но работает он только если:
- запущен из Word (применительно к текущему документу)
- запущен из Excel ВТОРОЙ раз в режиме ТОЛЬКО ЧТЕНИЕ (первый раз макрос открывает с диска Word документ - макрос видит только 6 StoryRanges (не все). Когда, не закрыв ранее открытый шаблон Word, запускаем макрос снова, - в Word выскакивает окошко, - типа, документ уже открыт, - "открыть только для чтения?" И вот когда мы в окне Word нажимаем «открыть только для чтения» - вот только тогда цикл видит все 12 StoryRanges)

За основу взят код отсюда (вариант Step3)
http://word.mvps.org/faqs/customizat...ceAnywhere.htm

когда макрос находит всё, он выводит в окне Immediate следующие типы StoryType:

1;5;5;6;7;7;8;9;9;9;10;10;10;10;11; 11;11;11;12;13;15;16;

когда макрос находит не всё, он выводит в окне Immediate следующие типы StoryType:

1;5;5;12;13;15;16;

причем, если отключить выполнение замен (строку WordReplacements myStoryRange, Key$, txt$),
то тогда он находит все объекты Range и выполняет замену внутри колонтитулов

Вот мой макрос:

Sub ToStartFromWord()
    Replace_Text ThisDocument, "{Номер объекта}", "111"
End Sub

Sub ToStartFromExcel()
    Filename$ = "c:\test.docx"
    Set WA = CreateObject("word.application"): WA.Visible = True
    Set word_document = WA.documents.Open(Filename$)
    Replace_Text word_document, "{Номер объекта}", "111"
End Sub

Sub Replace_Text(ByRef doc, ByVal Key$, ByVal txt$)
    Dim myStoryRange As Object, lngJunk As Long
    lngJunk = doc.Sections(1).Headers(1).Range.StoryType    'Fix the skipped blank Header/Footer problem
    
    For Each myStoryRange In doc.StoryRanges
        Do
            ' если следующую строку отключить - то находит все StoryRange
            WordReplacements myStoryRange, Key$, txt$

            Debug.Print myStoryRange.StoryType & ";";
            On Error Resume Next
            Select Case myStoryRange.StoryType
                Case 6, 7, 8, 9, 10, 11
                    'Debug.Print myStoryRange.StoryType, "shapes=" & myStoryRange.ShapeRange.Count
                    If myStoryRange.ShapeRange.Count > 0 Then
                        For Each oShp In myStoryRange.ShapeRange
                            If oShp.TextFrame.HasText Then WordReplacements oShp.TextFrame.TextRange, Key$, txt$
                        Next
                    End If
                Case Else
                    'Do Nothing
            End Select
            On Error GoTo 0
            
            Set myStoryRange = myStoryRange.NextStoryRange    'Get next linked story (if any)
        Loop Until myStoryRange Is Nothing
    
    Next myStoryRange
End Sub

Sub WordReplacements(ByVal rng As Object, ByVal FindText As String, ByVal ReplaceText As String)
    On Error Resume Next: rng.Find.Execute FindText:=FindText, ReplaceWith:=ReplaceText, Replace:=2
End Sub

Кто-нибудь с таким сталкивался?
Почему при открытии файла только для чтения, всё работает?
(если в коде открытия шаблона Word прописать ReadOnly = TRUE, файл откроется только для чтения БЕЗ ПОЯВЛЕНИЯ ДИАЛОГОВОГО ОКНА, и замены выполнятся не все. Т.е. появление этого диалогового окна что-то обновляет в документе, после чего все работает.)

[Step_UA]

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

    Dim rangeColl As New Collection
    For Each myStoryRange In doc.StoryRanges
        rangeColl.Add myStoryRange
    Next
    
    For Each myStoryRange In rangeColl 
       ...

[EducatedFool]

Спасибо большое, я как-то и не подумал про такой простой способ
Сделал, всё получилось