Word VBA: Como executar Selection.Find dentro de um intervalo pré-definido?

0

Eu tenho dois blocos de código Word VBA aqui que cada um funciona bem separadamente, mas que eu preciso combinar para obter o resultado desejado. Um identifica um intervalo de texto (oRng), enquanto o outro executa uma seleção. Encontre pesquisa para alterar algum texto. Eu preciso limitar a pesquisa Selection.Find para o intervalo definido por oRng.

Histórico: Eu tenho uma lista variável de artigos de notícias divididos em seções sob cabeçalhos (parágrafo único no estilo Header1), que também são variáveis. Eu preciso selecionar a linha de origem no artigo (parágrafo único em negrito) e copiá-lo para o final do cabeçalho do artigo (parágrafo único no estilo Header2). No entanto, certas seções precisam ser excluídas dessa operação, se o cabeçalho da seção for um termo específico.

Situação: Eu tenho código de trabalho para encontrar as linhas de origem do artigo e copiá-las para o final dos cabeçalhos dos artigos (percorrendo todo o documento usando Selection.Find). Eu também tenho código de trabalho para identificar as seções do texto onde o primeiro conjunto de código precisa ser aplicado, criando intervalos (oRng) entre os cabeçalhos de seção aplicáveis, percorrendo o documento seção por seção. O que eu preciso fazer é executar o primeiro conjunto de código (que é baseado em torno de Selection.Find) dentro dos intervalos especificados pelo segundo conjunto de código. Minha intenção era fazer o loop do código para identificar os intervalos e, como ele identifica cada intervalo, executar o código para copiar as linhas de origem para os cabeçalhos dentro desse intervalo, mas não consigo encontrar uma maneira de limitar a seleção.Encontre a pesquisa em um Faixa específica (oRng).

Alguém pode me ajudar com isso, por favor?

Primeiro bloco de código (Identifique intervalos entre os cabeçalhos de seção aplicáveis)

Sub SourceToArticleHeadersP2()
Dim oRng As Range
Dim oRngstart As Range
Dim oRngend As Range
Dim ArticleSource As Range
Dim ArticleHeader As Range
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
Loop
[SECOND BLOCK OF CODE GOES HERE]
End Sub

Segundo bloco de código (identifique linhas de origem e copie para linhas de cabeçalho de artigos, com base na formatação). Eu preciso modificar isso para que ele funcione apenas no intervalo de texto oRng.

With Selection.Find
 .Forward = True
 .ClearFormatting
 .Wrap = wdFindStop
 .Style = ActiveDocument.Styles(wdStyleHeading2)
 .Text = ""
 .Execute
End With
Do While Selection.Find.Found
 Set ArticleHeader = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End - 1)
 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
 With Selection.Find
  .Forward = True
  .ClearFormatting
  .Wrap = wdFindStop
  .Style = ActiveDocument.Styles(wdStyleHeading2)
  .Text = ""
  .Execute
 End With
Loop

O documento de destino tem um layout semelhante a este (o número de seções e artigos é variável). As linhas que estou procurando no código acima estão em negrito:

[2+ Páginas de texto de abertura e TOC]

Cabeçalho da seção 1 (Estilo: Título 1)

Cabeçalho do artigo 1 (Estilo: Heading2)
Linhas variáveis do texto do cabeçalho
Nome da fonte do artigo 1 (em negrito)
Mais linhas variáveis de texto de cabeçalho
Texto do corpo do artigo
Quebra de página

Cabeçalho do Artigo 2 (Estilo: Heading2)
Linhas variáveis do texto do cabeçalho
Artigo 2 nome da fonte (em negrito)
Mais linhas variáveis de texto de cabeçalho
Texto do corpo do artigo
Quebra de página

Cabeçalho da seção 2 (Estilo: Título 1)

Cabeçalho do Artigo 3 (Estilo: Heading2)
Linhas variáveis do texto do cabeçalho
Artigo 3 nome da fonte (em negrito)
Mais linhas variáveis de texto de cabeçalho
Texto do corpo do artigo
Quebra de página

[...]

    
por Lobosolitario 04.03.2015 / 11:00

1 resposta

0

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
    
por 04.03.2015 / 19:52