Want nonbreaking space before wdRefField Select

[jec1]

Hi in Word 2007/10

Want to replace 1 space (whatever it is - white space, non breaking space) before ALL wdREFField in Active Document with non breaking space Char(160). The below macro is called by another macro which applies a style to specific words (Clauses clause clauses annexure annexures Annexures) which all appear before wdREFfield. Rather than search a selection of single or pural words.

It can be incorporated in below macro or separately.

Sub wdFieldRefStyle()
Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldRef Then
oField.Select
With Selection
.Style = "xRef"
End With
End If
Next oField
End Sub

Many thanks for any assistance.
Janine

[Andrew Lockton]

Try this macro

Sub wdFieldRefStyle() 
Dim oField As Field, aRng As Range
  For Each oField In ActiveDocument.Fields
    If oField.Type = wdFieldRef Then
      oField.Result.Style = "xRef"
      Set aRng = oField.Result
      aRng.MoveStart wdCharacter, -1
      aRng.Collapse Direction:=wdCollapseStart
      aRng.MoveEnd wdCharacter, 1
      If aRng.Text = " " Then
        aRng.Delete wdCharacter, 1
        aRng.InsertBefore Chr(160)
      End If
    End If
  Next oField
End Sub

[jec1]

Hi Andrew,

Thank you Andrew that's great.

I would like to select 1 whole word left of the Chr(160) be it clause clauses schedule schedules annexure annexures doesn't matter as it always occurs before the wdRefField) and apply the xRef style. Is it better to select the whole word, then add the non breaking space and xref style or do them separately Andrew do you think.

Much appreciate your help.

[macropod]

Try:

Sub wdFieldRefStyle()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range, StrSty As String, StrWds As String
StrSty = "xRef"
StrWds = " clause clauses schedule schedules annexure annexures "
With ActiveDocument
  For Each Fld In .Fields
    With Fld
      If .Type = wdFieldRef Then
        If InStr(.Code.Text, "MERGEFORMAT") > 0 Then
          .Code.Text = Replace(.Code.Text, "MERGEFORMAT", "CHARFORMAT")
        ElseIf InStr(.Code, "\h") > 0 Then
          .Code.Text = Split(.Code.Text, "\h")(0) & "\* CHARFORMAT & \h"
        Else
          .Code.Text = .Code.Text & "\* CHARFORMAT"
        End If
        .ShowCodes = True
        .Code.Words.First.Characters.First.Style = StrSty
        .ShowCodes = False
        .Update
        Set Rng = .Result
        With Rng
          While .Characters.First.Previous.Previous = " "
            .Characters.First.Previous.Previous.Delete
          Wend
          If InStr(StrWds, " " & .Characters.First.Previous.Words.First) > 0 Then
            .MoveStart wdWord, -1
            .End = .Words.First.End
            .Style = StrSty
            .Characters.Last.Delete
            .InsertAfter Chr(160)
          Else
            .Characters.First.Previous.Delete
            .InsertBefore Chr(160)
          End If
        End With
      End If
    End With
  Next Fld
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[jec1]

Very much appreciate the help but not there yet.

It does not select words at the beginning of sentences because " " and the macro needs to run more than once so it needs to just apply what it does regardless of whether it has been done already.

Also the word "and" in context clauses 1 and 2 - the andChar(160). The 160 is not necessary so I would have to do a find/replace of and160 and just put the white space back I guess.

See attached doc it cuts of the words and bounces the bold. I need the features to reapply regardless of state.

Any ideas most welcome.

[macropod]

Hi jec,

You'll need to clarify:

Also the word "and" in context clauses 1 and 2 - the andChar(160). The 160 is not necessary so I would have to do a find/replace of and160 and just put the white space back.

In the interim, try:

Sub wdFieldRefStyle()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range, StrSty As String, StrWds As String
StrSty = "xRef"
StrWds = " clause clauses schedule schedules annexure annexures "
With ActiveDocument
  For Each Fld In .Fields
    With Fld
      If .Type = wdFieldRef Then
        If InStr(.Code.Text, "CHARFORMAT") = 0 Then
          If InStr(.Code.Text, "MERGEFORMAT") > 0 Then
            .Code.Text = Replace(.Code.Text, "MERGEFORMAT", "CHARFORMAT")
          ElseIf InStr(.Code, "\h") > 0 Then
            .Code.Text = Split(.Code.Text, "\h")(0) & "\* CHARFORMAT & \h"
          Else
            .Code.Text = .Code.Text & "\* CHARFORMAT"
          End If
        End If
        Set Rng = .Code
        Rng.Words.First.Next.Characters.First.Style = StrSty
        .Update
        Set Rng = .Result
        With Rng
          If .Characters.First.Previous = Chr(160) Then
            .Characters.First.Previous.InsertAfter " "
          End If
          While .Characters.First.Previous.Previous = " " Or .Characters.First.Previous.Previous = Chr(160)
            .Characters.First.Previous.Previous.Delete
          Wend
          If InStr(UCase(StrWds), " " & UCase(.Characters.First.Previous.Words.First)) > 0 Then
            .MoveStart wdWord, -1
            .End = .Words.First.End
            .Style = StrSty
            .Characters.Last.Delete
            .InsertAfter Chr(160)
          Else
            .Characters.First.Previous.Delete
            .InsertBefore Chr(160)
          End If
        End With
      End If
    End With
  Next Fld
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[Andrew Lockton]

Like this?

Sub wdFieldRefStyle2()
  Dim oField As Field, aRng As Range, sStr As String
  For Each oField In ActiveDocument.Fields
    If oField.Type = wdFieldRef Then
      Set aRng = oField.Result
      aRng.MoveStart wdCharacter, -1
      aRng.Expand wdWord
      sStr = aRng.Words(1).Text
      If sStr = "and " Then
        oField.Result.Style = "xRef"
      Else
        sStr = Replace(sStr, " ", Chr(160))
        aRng.Words(1).Text = sStr
        aRng.Style = "xRef"
      End If
    End If
  Next oField

[jec1]

Hi Macropod

Great BUT the words" This is clause wdREFField and wdREFField. The "and" gets chopped off letter by letter each time you run the macro. The non breaking space becomes incorporated in the wdREFField.

THANK YOU for working on this much appreciated. I'v got some good ideas to improve my range abilities.
Much appreciated.

[jec1]

Andrew

THANK YOU SO MUCH. Owe you big time for this much appreciated.
Need to change selection process and apply xRef style in one go. Then do non breaking space If Not Non Breaking Space (style xRef is already applied so no need to reapply).

As it is it creates a new Style(3) and a bold white space after wdREFField and when I select all Instances of style xRef it doesn't.

So is it possible to
Select wdREFField then 1 space left then 1 Word (text) left THEN apply xRef Style.
The apply non breaking space before wdREFField If Not Non Breaking Space Else Nothing End If???

Then there is only one xRef style applied to the whole lot "Clause 5.3" or clauses 5.3 and 5.2 (that may still present a problem) although I can run the original macro to bold all wdREFFields and that may fix the and wdREFField partial field code.

Hope that makes sense.

[macropod]

Hi jec,

Change the last Else ... End If to:

          Else
            .MoveStart wdWord, -1
            .End = .Words.First.End
            .Characters.Last.Delete
            .InsertAfter Chr(160)
          End If

[Andrew Lockton]

Janine

We seem to be running around in circles here because you are not specifying what you want very clearly.

It sounds like the macro is almost there but you also want the instances of "clause_# and_#" where the underscore is a non-breaking space and the entire thing is using the character style. If that is the case, try this version

Sub wdFieldRefStyle3()
  Dim oField As Field, aRng As Range, sStr As String
  For Each oField In ActiveDocument.Fields
    If oField.Type = wdFieldRef Then
      Set aRng = oField.Result
      aRng.MoveStart wdCharacter, -1
      aRng.Expand wdWord
      sStr = aRng.Words(1).Text
      sStr = Replace(sStr, " ", Chr(160))
      aRng.Words(1).Text = sStr
      If sStr = "and " Then
        aRng.MoveStart wdCharacter, -1
      End If
      aRng.Style = "xRef"
    End If
  Next oField
End Sub

[jec1]

That is good thank you.

[jec1]

Perfect thank you Macropod.