Consulting

Results 1 to 7 of 7

Thread: New line added in header by a replace

  1. #1
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    4
    Location

    New line added in header by a replace

    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
    Last edited by Bamaury; 02-02-2017 at 07:39 AM.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,118
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  4. #4
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    4
    Location
    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
    Last edited by Bamaury; 02-02-2017 at 07:27 AM. Reason: typo

  5. #5
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    4
    Location
    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

  6. #6
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    VBAX Newbie
    Joined
    Feb 2017
    Posts
    4
    Location
    Thank you
    Please mark this thread as Solved if I d'ont find how to do it myself

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •