Headers and image, edit text

[BigfootN]

Hello,

I am having some problems editing headers containing some images. In those headers, there are tables containing images, and I need to replace some marks in the form of <mark> with a new text. In the body of the document there is no problem, but when applying the same technique, it just deletes the images, and the content of the header is just not the same. Since I was unable to edit the header with a range I edited the header with the text and completely replaced it with the new text.

So what I would like to be able to do is to be able to search for marks, and replace them, and only replacing the text not the images in order to keep the headers intact. This is the code that I use to go through each header of every page:

Dim oSec As Section
Dim oFoot As HeaderFooter

For Each oSec In ActiveDocument.Sections
        For Each oHead In oSec.Footers
            oFoot.range.text = replaceMarks(oFoot.range.text)
        Next oHead
Next oSec

So, if anyone has an idea, thank you very much in advance

[gmayor]

You seem to be getting confused with your headers and footers. I have no idea what your replaceMarks function does, but whatever it is it will have more of a chance if you set the correct range.

Dim oSec As Section 
Dim oFoot As HeaderFooter 
 
For Each oSec In ActiveDocument.Sections 
    For Each oFoot In oSec.Footers 
        replaceMarks(oFoot.range) 
    Next oFoot 
Next oSec

This will at least allow you to work within the correct range, but your function should set a range to the mark itself e.g.

Sub replaceMarks(oRng As Range)
    With oRng.Find
        Do While .Execute(FindText:="<mark>")
            oRng.Text = "Replacement text"
            oRng.Collapse 0
        Loop
    End With
End Sub

[BigfootN]

Hello,

Thank you for your response, I'm unable to test your solution today, but I'll you more about it tomorrow. The only thing I can tell you, is that I tried editing the header with the range, but I am unable to do so with the range. Nothing happens. I already create a sub working with the range, for the body of the document, and it perfectly works. But for the header nothing happens. Surely I would have had also preferred to work with the range, but it never worked, nothing happens.

Also, I have to go through all the text, I'm unable to use

Do While .Execute(FindText:="<mark>") 
    oRng.Text = "Replacement text" 
    oRng.Collapse 0 
Loop

since there are several marks with several values, so I need to go through all the text contained in the headers.

And replaceMarks goes through all the text and replaces the marks with their values.

Thank you very much for your answer
P.S: I don't know why, but I put the footers in my example, but I meant the headers

[gmayor]

The suggested code assumed a single mark in the header/footer. To process multiple marks it requires a few minor changes e.g.

Option Explicit

Sub EditHeader()
Dim oSection As Section
Dim oHeader As HeaderFooter
    For Each oSection In ActiveDocument.Sections
        For Each oHeader In oSection.Headers
            If oHeader.Exists Then
                replaceMarks oHeader
            End If
        Next oHeader
    Next oSection
lbl_Exit:
    Set oHeader = Nothing
    Set oSection = Nothing
    Exit Sub
End Sub

Private Sub replaceMarks(oHeader As HeaderFooter)
Dim oRng As Range
Dim i As Integer
Const strFind As String = "<mark1>|<mark2>|<mark3>|<mark4>"
Const strRepl As String = "Replace Text 1|Replace Text 2|Replace Text 3|Replace Text 4"
    For i = 0 To UBound(Split(strFind, "|"))
        Set oRng = oHeader.Range
        With oRng.Find
            Do While .Execute(FindText:=Split(strFind, "|")(i))
                oRng.Text = Split(strRepl, "|")(i)
                oRng.Collapse 0
            Loop
        End With
    Next i
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

[BigfootN]

Hello,

Thank you for your response and patience. To be honest, my marks are saved in a dictionary with the mark as a key and the value containing the value of the mark. So, in order to keep a certain performance, I iterate through the hole text (of the header, footer or body) character by character and search for a "<", and when found, replace the mark in question with it's value thanks to the dictionary. That's what the replaceMarks does. So I don't know how I am able to use your solution. Please give me a hint

Thank you again very much for your help

[gmayor]

Post your existing code (and the dictionary) so I can see how it is using your dictionary, and thus enable the changes to be made to the suggested macro to process the whole document.

[BigfootN]

Hello,

So here is the code:

Private Sub replaceMarksInRng(rng As range)
On Error GoTo Handler:
    ' ranges
    Dim ch As range
    Dim markRng As range
    Dim isLocked As Boolean
    
    ' variable utils
    Dim key As String
    Dim value As String
    Dim length As Integer

    Set ch = rng
    
    Do
    If (StrComp(ch.text, "<") = 0) Then
    
        ' prepare the range of the next mark
        Set markRng = ActiveDocument.range(ch.Start, ch.End)
        Do
            Set ch = ch.Next
        Loop While StrComp(ch.text, ">") <> 0
        
        ' select the mark's range to be able to modify it
        Set markRng = ActiveDocument.range(Start:=markRng.Start, End:=ch.End)
        markRng.Select
        
        ' retrieve key and value
        key = ActiveDocument.range(markRng.Start + 1, markRng.End - 1).text
        value = dicPatDat(key)
        length = Len(value)
        
        Options.ReplaceSelection = True
        If dicPatDat.exists(key) And length > 0 Then
            value = dicPatDat(key)
            modifySelect value
        Else
            Selection.delete
        End If
        
        ' go to the next range or calculate the next one if the new text wasn't empty
        ' according to it's length
        If (length > 0) Then
            ch.SetRange markRng.Start + length, markRng.Start + length + 1
        Else
            If (ch.text <> "<") Then
                Set ch = ch.Next
            End If
        End If
    Else
        Set ch = ch.Next
    End If
    Loop Until ch Is Nothing
    
    Set ch = Nothing
    
    Exit Sub
Handler:
    Debug.Print "Error in Replance Rng : " & Err.Description
End Sub

And modifySelect :

Private Sub modifySelect(text As String)
    Options.ReplaceSelection = True
    
    Selection.TypeText text
End Sub

with dicPatDat the dictionary.

Thank you again

[gmaxey]

Is your code a state secret or something? Why don't you post your code start to finish instead of making the people trying to help you put it together from bits and pieces? I still have no clear idea what you are trying to do. Whatever it is, I feel fairly confident that I wouldn't do it the way you are trying to do it.

If you want to find a value defined by a dictionary key and replace that value with the content of the key then why don't you simply use .Find?

Option Explicit
Dim dicPatDat As Object
Sub Test()
  Set dicPatDat = CreateObject("Scripting.Dictionary")
  dicPatDat.Add "a", "apple"
  dicPatDat.Add "b", "blueberry"
  replaceMarksInRng ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
End Sub
Private Sub replaceMarksInRng(rng As Range)
Dim lngIndex As Long
Dim oRng As Word.Range
Dim varKeys, varItems
  varKeys = dicPatDat.Keys
  For lngIndex = 0 To UBound(varKeys)
    Set oRng = rng.Duplicate
    With oRng.Find
      .text = "<" & varKeys(lngIndex) & ">"
      .Replacement.text = dicPatDat(varKeys(lngIndex))
      .Execute Replace:=wdReplaceAll
    End With
  Next
End Sub

[BigfootN]

Hello,

Thank you very much for your answer, but I am currently not at work, so I won't be able to submit my code until Monday.

Thank you again very much for your help

[BigfootN]

Hello,

So here as an example of a header:

header.jpg
In this example, the header doesn't contain any marks, or text.

And if I take the text of the header, so oFoot.Range.Text, it also contains:

 ... Campus  <CAMPUS> ...

in the text, which is not part of the marks I wish to replace. The problem is that, in the text (what is real text), it is possible that I encounter a mark without any value, or not part of the dictionary containing the marks and their respective values, which I then delete.

So here the problem is that since the mark <CAMPUS> is not part of the marks I am searching for at all, my algorithm just leaves a blank which gives:

 ... Campus ...

So, to summarize, I would like to be able to tell the difference between what is really text and what is an image or shape.

If any further information or explanation is needed, please let me know.

Thank you again very much

[gmaxey]

What you have just tried to explain is completely unfathomable to my simple mind. If you look at the code that I sent to you, unless you have "campus" defined in the dictionary then it isn't going to do anything with your <CAMPUS>.