Preciso selecionar e colocar 1 intervalo com vários parágrafos e colocar todos no mesmo parágrafo sem alterar o restante do documento. Estou tentando fazer esta alteração com o código abaixo, porém sem sucesso. Alguém pode me ajudar?
Sub 4()
Dim startText As String
Dim endText As String
Dim startPos As Long
Dim endPos As Long
Dim doc As Document
Dim rng As Range
Dim searchPos As Long
startText = "End.: "
endText = "Bairro: "
Set doc = ActiveDocument
searchPos = 1
Do
startPos = InStr(searchPos, doc.Content.Text, startText)
If startPos = 0 Then Exit Do
endPos = InStr(startPos + Len(startText), doc.Content.Text, endText)
If endPos = 0 Then Exit Do
Set rng = doc.Range(startPos - 1, endPos - 1)
'rng.Font.Color = wdColorRed
rng.Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.MoveDown Unit:=wdLine, Count:=1
searchPos = endPos + Len(endText)
Loop
End Sub
Pergunta
Henrique Sanches
Preciso selecionar e colocar 1 intervalo com vários parágrafos e colocar todos no mesmo parágrafo sem alterar o restante do documento.
Estou tentando fazer esta alteração com o código abaixo, porém sem sucesso.
Alguém pode me ajudar?
Sub 4() Dim startText As String Dim endText As String Dim startPos As Long Dim endPos As Long Dim doc As Document Dim rng As Range Dim searchPos As Long startText = "End.: " endText = "Bairro: " Set doc = ActiveDocument searchPos = 1 Do startPos = InStr(searchPos, doc.Content.Text, startText) If startPos = 0 Then Exit Do endPos = InStr(startPos + Len(startText), doc.Content.Text, endText) If endPos = 0 Then Exit Do Set rng = doc.Range(startPos - 1, endPos - 1) 'rng.Font.Color = wdColorRed rng.Select Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "^p" .Replacement.Text = " " .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll Selection.MoveDown Unit:=wdLine, Count:=1 searchPos = endPos + Len(endText) Loop End Sub
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.