New line added in header by a replace

[Bamaury]

Hello,

I have a small and simple problem but i'm not very good with Selection and Range, etc... The problem is that, in the header, when I try to replace some text, a new line is automatically added a the end. Exemple :

Coca-Cola(end of line)
blablabla(end of line)
(end of line)

vv action vv

Pepsi(end of line)
blablabla(end of line)
(end of line)
(end of line)


I just need a solution that prevents this , or a solution that delete last line.

Here the code used :

Public Sub ForceCocaToPepsi(ByRef wdocDocument As Word.Document)    Dim lngI As Long
    Dim lngJ As Long
    Dim wrngCurrent As Word.Range
    
    For lngI = 1 To wdocDocument.Sections.Count
        For lngJ = 1 To wdocDocument.Sections(lngI).Headers.Count
            Set wrngCurrent = wdocDocument.Sections(lngI).Headers(lngJ).Range
            If InStr(1, wrngCurrent.Text, "Coca") Then
                wdocDocument.Sections(lngI).Headers(lngJ).Range.Text = Replace(wrngCurrent.Text, "Coca", "Pepsi")
            End If
        Next lngJ
       

    Next lngI

Thank you,

Amaury Bianchi

[gmayor]

The following should work

Public Sub ForceCocaToPepsi(ByRef wdocDocument As Word.Document)
Dim lngI As Long
Dim lngJ As Long
Dim wrngCurrent As Word.Range
    For lngI = 1 To wdocDocument.Sections.Count
        For lngJ = 1 To wdocDocument.Sections(lngI).Headers.Count
            Set wrngCurrent = wdocDocument.Sections(lngI).Headers(lngJ).Range
            If InStr(1, wrngCurrent.Text, "sanofi pasteur") Then
                With wrngCurrent.Find
                    Do While .Execute(FindText:="Coca")
                        wrngCurrent.Text = "Pepsi"
                        wrngCurrent.Collapse
                    Loop
                End With
            End If
        Next lngJ
    Next lngI
End Sub

[gmaxey]

Sub Test()
  ForceCocaToPepsi ActiveDocument
  ForcePepsiToCoca ActiveDocument
End Sub
Public Sub ForceCocaToPepsi(ByRef oDoc As Word.Document)
Dim lngSection As Long, lngIndex As Long
Dim oRng As Word.Range
 For lngSection = 1 To oDoc.Sections.Count
   For lngIndex = 1 To 3
     Set oRng = oDoc.Sections(lngSection).Headers(lngIndex).Range
     oRng.End = oRng.End - 1
     If InStr(1, oRng.Text, "sanofi pasteur") Then
       oDoc.Sections(lngSection).Headers(lngIndex).Range.Text = Replace(oRng.Text, "Coca", "Pepsi")
     End If
        Next lngIndex
    Next lngSection
lbl_Exit:
  Exit Sub
End Sub
'or
Public Sub ForcePepsiToCoca(ByRef oDoc As Word.Document)
Dim lngSection As Long, lngIndex As Long
Dim oRng As Word.Range
  For lngSection = 1 To oDoc.Sections.Count
    For lngIndex = 1 To 3
      Set oRng = oDoc.Sections(lngSection).Headers(lngIndex).Range
      With oRng.Find
        .Text = "Pepsi"
        .Replacement.Text = "Coca"
        .Execute Replace:=wdReplaceAll
      End With
    Next lngIndex
  Next lngSection
lbl_Exit:
  Exit Sub
End Sub

[Bamaury]

Well i made a mistake in my first post by forgetting to change the name of the company by "Coca" in the first If ^^' so when trying the first solution, an infinite loop occurs (and i don't understand why because if test coca but write pepsi, it should stop when everything is replaced).

I'll try the gmaxey option now

[Bamaury]

There is still the new line with the gmaxey's solution do you think it's possible that the probleme comes from an other function? The problem is that I can't debug to see in live when the line appears because the document is blank when debugging.

Thank you

[gmayor]

Based on your original code, I would do it this way. It should not go into an infinite loop.

Public Sub ForceCocaToPepsi(ByRef wdocDocument As Word.Document)
Dim oSection As Section
Dim oHeader As HeaderFooter
Dim oRng As Word.Range
    For Each oSection In wdocDocument.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                Set oRng = oHeader.Range
                If InStr(1, oRng.Text, "sanofi pasteur") > 0 Then
                    With oRng.Find
                        Do While .Execute(FindText:="Coca")
                            oRng.Text = "Pepsi"
                            oRng.Collapse
                        Loop
                    End With
                End If
            End If
        Next oHeader
    Next oSection
End Sub

[Bamaury]

Thank you
Please mark this thread as Solved if I d'ont find how to do it myself