Shelley_Lou
07-14-2022, 03:47 AM
Hi Macropod - while searching the internet for a related topic on cross references I came across a post on this forum started back in 2021 in which you supplied the code below - unfortunately I was unable to add a reply to that post as it was marked as resolved and generated an error when trying to add my query, so have created a new thread. I apologise if this is not the correct process. I just wanted to ask a couple of questions if possible.
Firstly in relation to that post, I have a similar issue whereby my house style document has Heading 5 as (a) so if any references are for example, clause 1.1.1.1(a) would it be possible to tell the code to skip the cross reference for any levels that are followed by (a), (b) etc. and instead just highlight them, so I know I need to come back to that reference and cross reference manually.
My second query is in my house style documents the main body uses Heading 1-7 and the schedules use Schedule Level 1-7 - at the moment the code only picks up the Heading styles - is there something I could add to the code for it to know what style it should be cross referencing.
Many thanks
Sub InsertAutoXRefs()Application.ScreenUpdating = False
Dim Doc As Document, Para As Paragraph
Dim ListNums As String, StrNum As String
Dim i As Long, j As Long, x As Long
Set Doc = ActiveDocument: ListNums = "|"
With Doc
For Each Para In .Paragraphs
With Para.Range.ListFormat
If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
End With
Next
For i = 1 To UBound(Split(ListNums, "|")) - 1
x = Len(Split(ListNums, "|")(i))
If x > j Then j = x
Next
Do While j > 0
For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
If x = j Then
ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
Call MakeAutoXRefs(Doc, StrNum)
End If
Next
j = j - 1
Loop
End With
Application.ScreenUpdating = True
End Sub
Sub MakeAutoXRefs(Doc As Document, StrNum As String)Dim RefList As Variant, i As Long, j As Long
With Doc
RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
For i = 1 To UBound(RefList)
If Split(Trim(RefList(i)), " ")(0) = StrNum Then
j = i: Exit For
End If
Next
If j = 0 Then Exit Sub
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.text = " " & StrNum
.Replacement.text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
End With
Do While .Find.Execute
If .Fields.Count = 0 Then
.Start = .Start + 1
.InsertCrossReference ReferenceType:="Numbered item", _
ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
InsertAsHyperlink:=True, IncludePosition:=False, _
SeparateNumbers:=False, SeparatorString:=" "
.End = .End + 1
.End = .Fields(1).Result.End
End If
.Collapse wdCollapseEnd
Loop
End With
End With
End Sub
Firstly in relation to that post, I have a similar issue whereby my house style document has Heading 5 as (a) so if any references are for example, clause 1.1.1.1(a) would it be possible to tell the code to skip the cross reference for any levels that are followed by (a), (b) etc. and instead just highlight them, so I know I need to come back to that reference and cross reference manually.
My second query is in my house style documents the main body uses Heading 1-7 and the schedules use Schedule Level 1-7 - at the moment the code only picks up the Heading styles - is there something I could add to the code for it to know what style it should be cross referencing.
Many thanks
Sub InsertAutoXRefs()Application.ScreenUpdating = False
Dim Doc As Document, Para As Paragraph
Dim ListNums As String, StrNum As String
Dim i As Long, j As Long, x As Long
Set Doc = ActiveDocument: ListNums = "|"
With Doc
For Each Para In .Paragraphs
With Para.Range.ListFormat
If .ListString <> "" Then ListNums = ListNums & .ListString & "|"
End With
Next
For i = 1 To UBound(Split(ListNums, "|")) - 1
x = Len(Split(ListNums, "|")(i))
If x > j Then j = x
Next
Do While j > 0
For i = UBound(Split(ListNums, "|")) - 1 To 1 Step -1
StrNum = Split(ListNums, "|")(i): x = Len(StrNum)
If x = j Then
ListNums = Replace(ListNums, "|" & StrNum & "|", "|")
Call MakeAutoXRefs(Doc, StrNum)
End If
Next
j = j - 1
Loop
End With
Application.ScreenUpdating = True
End Sub
Sub MakeAutoXRefs(Doc As Document, StrNum As String)Dim RefList As Variant, i As Long, j As Long
With Doc
RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
For i = 1 To UBound(RefList)
If Split(Trim(RefList(i)), " ")(0) = StrNum Then
j = i: Exit For
End If
Next
If j = 0 Then Exit Sub
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.text = " " & StrNum
.Replacement.text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
End With
Do While .Find.Execute
If .Fields.Count = 0 Then
.Start = .Start + 1
.InsertCrossReference ReferenceType:="Numbered item", _
ReferenceKind:=wdNumberFullContext, ReferenceItem:=j, _
InsertAsHyperlink:=True, IncludePosition:=False, _
SeparateNumbers:=False, SeparatorString:=" "
.End = .End + 1
.End = .Fields(1).Result.End
End If
.Collapse wdCollapseEnd
Loop
End With
End With
End Sub