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