Shelley_Lou
10-06-2023, 06:01 AM
I am hoping someone can help me with a couple of issues I have with the below code.
A while ago I found the code to insert cross references but there were a few issues in relation to the code running on my house style documents so I stopped using it but never fixed the issues. I have a ton of documents to house style and cross reference and therefore would like to resolve the issues so I can run the code to speed up the house style process.
When running the code it is cross referencing random numbers within the document which are not related to a clause/paragraph reference i.e. Heading 1-4. I would like the code to only insert an auto cross reference where the word 'Clause' or 'clause' is followed by 1., 1.1, 1.1.1 or 1.1.1.1 - My documents are split into two sections - first section uses Heading 1-7 (clause) and the second section uses Schedule Level 1-7 (paragraph). I'm hoping I can adapt the code to also include Schedule Level Numbering that looks for the word 'Paragraph' or 'paragraph'.
For house style, Heading 1 has a period e.g. 1., 2. etc. but the code is not recognising this - is there a way to search for Heading 1 with a period and then insert the auto cross ref but without the period. The only other solution I thought for this was to first remove the period from Heading 1 run the code then reinstate the period.
I have attached a test document so you can see what the code does to my document.
I would appreciate any help or advice on this.
Many thanks
31093
31092
Sub DPU_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
Options.DefaultHighlightColorIndex = wdYellow
Set doc = ActiveDocument: ListNums = "|"
With doc
For Each Para In .Paragraphs
With Para.Range.ListFormat
If .ListString <> "" Then
If InStr(ListNums, "|" & .ListString & "|") = 0 Then ListNums = ListNums & .ListString & "|"
End If
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 DPU_MakeAutoXRefs(doc, StrNum)
End If
Next
j = j - 1
Loop
End With
Application.ScreenUpdating = True
End Sub
Sub DPU_MakeAutoXRefs(doc As Document, StrNum As String)
Dim RefList As Variant, i As Long, j As Long
With doc
If Left(StrNum, 1) = "(" Then
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = Trim(StrNum)
.Replacement.text = "^&"
.Replacement.Highlight = True
.Format = True
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.Execute Replace:=wdReplaceAll
End With
Else
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 If
End With
End Sub
A while ago I found the code to insert cross references but there were a few issues in relation to the code running on my house style documents so I stopped using it but never fixed the issues. I have a ton of documents to house style and cross reference and therefore would like to resolve the issues so I can run the code to speed up the house style process.
When running the code it is cross referencing random numbers within the document which are not related to a clause/paragraph reference i.e. Heading 1-4. I would like the code to only insert an auto cross reference where the word 'Clause' or 'clause' is followed by 1., 1.1, 1.1.1 or 1.1.1.1 - My documents are split into two sections - first section uses Heading 1-7 (clause) and the second section uses Schedule Level 1-7 (paragraph). I'm hoping I can adapt the code to also include Schedule Level Numbering that looks for the word 'Paragraph' or 'paragraph'.
For house style, Heading 1 has a period e.g. 1., 2. etc. but the code is not recognising this - is there a way to search for Heading 1 with a period and then insert the auto cross ref but without the period. The only other solution I thought for this was to first remove the period from Heading 1 run the code then reinstate the period.
I have attached a test document so you can see what the code does to my document.
I would appreciate any help or advice on this.
Many thanks
31093
31092
Sub DPU_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
Options.DefaultHighlightColorIndex = wdYellow
Set doc = ActiveDocument: ListNums = "|"
With doc
For Each Para In .Paragraphs
With Para.Range.ListFormat
If .ListString <> "" Then
If InStr(ListNums, "|" & .ListString & "|") = 0 Then ListNums = ListNums & .ListString & "|"
End If
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 DPU_MakeAutoXRefs(doc, StrNum)
End If
Next
j = j - 1
Loop
End With
Application.ScreenUpdating = True
End Sub
Sub DPU_MakeAutoXRefs(doc As Document, StrNum As String)
Dim RefList As Variant, i As Long, j As Long
With doc
If Left(StrNum, 1) = "(" Then
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.text = Trim(StrNum)
.Replacement.text = "^&"
.Replacement.Highlight = True
.Format = True
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
.Execute Replace:=wdReplaceAll
End With
Else
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 If
End With
End Sub