Eu consegui resolver isso no final, contando os parágrafos em oRng que usavam o estilo Header2, e fazendo o loop da segunda busca o número apropriado de vezes desde o início de oRng (código abaixo).
Eu ainda estaria muito interessado em saber se há outra maneira de limitar um loop com várias pesquisas para que ele funcione somente dentro de um intervalo específico - a única ideia que tenho é executar a primeira pesquisa usando o oRng.Find, colapso ao fim, redefinir oRNG como (posição atual, oRender) e percorrer esse caminho, com o intervalo se tornando progressivamente menor à medida que a pesquisa avança até chegar ao ponto em que não há correspondência entre a posição atual e o final.
Agradecemos um milhão a @Raystafarian por muitas sugestões úteis e uma grande dose de paciência!
Sub SourceToArticleHeaders()
'Copy article source to article header
Dim oRng As Range
Dim oRngstart As Range
Dim oRngend As Range
Dim ArticleSource As Range
Dim ArticleHeader As Range
Dim oPara As Paragraph
Dim A As Long
A = 0
Dim excludedTerms(1 To 5) As String
excludedTerms(1) = "TERM1"
excludedTerms(2) = "TERM1"
excludedTerms(3) = "TERM1"
excludedTerms(4) = "TERM1"
excludedTerms(5) = "TERM1"
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Text = ""
.Execute
End With
Do While Selection.Find.Found
For i = 1 To 5
If InStr(1, Selection.Text, excludedTerms(i), vbTextCompare) Then
Selection.Collapse wdCollapseEnd
' MsgBox excludedTerms(i) & " detected - skipping"
Selection.Find.Execute
End If
Next i
Set oRngstart = Selection.Range
' MsgBox "Start = " & oRngstart
Selection.Collapse wdCollapseEnd
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Text = ""
.Execute
End With
If Selection.Find.Found Then
Set oRngend = Selection.Range
' MsgBox "End = " & oRngend
Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=oRngend.Start)
Selection.Collapse wdCollapseStart
Selection.Find.Execute
Else
' MsgBox "End = End of Document"
Set oRng = ActiveDocument.Range(Start:=oRngstart.End, End:=ActiveDocument.Range.End)
End If
For Each oPara In oRng.Paragraphs
If oPara.Range.Style = ActiveDocument.Styles(wdStyleHeading2) Then
A = A + 1
End If
Next
' MsgBox A & " articles"
oRng.Select
For A = 1 To A
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading2)
.Text = ""
.Execute
End With
Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
Selection.Collapse wdCollapseEnd
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Font.Bold = True
.Text = ""
.Execute
End With
Set ArticleSource = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
ArticleHeader.InsertAfter " (" & ArticleSource & ")"
Selection.Collapse wdCollapseEnd
Next A
A = 0
With Selection.Find
.Forward = True
.ClearFormatting
.Wrap = wdFindStop
.Style = ActiveDocument.Styles(wdStyleHeading1)
.Text = ""
.Execute
End With
Loop
End Sub