Forum Discussion
VBA Code/possible
Take this:
Sub CheckCrossReferences()
Dim fld As Field
Dim refType As String
Dim refTarget As String
Dim msg As String
Dim countBroken As Integer
Dim countTotal As Integer
countBroken = 0
countTotal = 0
msg = ""
For Each fld In ActiveDocument.Fields
If fld.Type = wdFieldRef Then
countTotal = countTotal + 1
On Error Resume Next
refTarget = fld.Result.Text
If fld.Result = "" Or InStr(1, fld.Code.Text, "\h") = 0 Then
msg = msg & "Broken or non-hyperlinked reference: " & fld.Code.Text & vbCrLf
countBroken = countBroken + 1
End If
On Error GoTo 0
End If
Next fld
msg = msg & vbCrLf & "Total cross-references: " & countTotal & vbCrLf
msg = msg & "Broken or missing hyperlinks: " & countBroken
MsgBox msg, vbInformation, "Cross-Reference Check"
End Sub
Kidd-Ip,
It is a little more involved than that. First, "For Each oFld in ActiveDocument.Fields" does not include "all" fields in the document. Only the fields of the storyrange containing the selection. Second, I don't believe just a "" Result value or a missing */h would indicate a broken Ref. Consider:
Option Explicit
Type typCRs
Total As Long
Broken As Long
End Type
Sub ValidateCrossReferences()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape, oCanShp As Shape
Dim lngStoryCount As Long, lngCountTotal As Long, lngBroke As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
lngStoryCount = 0
Do
On Error Resume Next
'lngStoryCount = CheckCrossReferences(rngStory)
lngCountTotal = lngCountTotal + CheckCrossReferences(rngStory).Total
lngBroke = lngBroke + CheckCrossReferences(rngStory).Broken
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
CheckCrossReferences oShp.TextFrame.TextRange
End If
If oShp.Type = msoCanvas Then
For Each oCanShp In oShp.CanvasItems
If oCanShp.TextFrame.HasText Then
CheckCrossReferences oCanShp.TextFrame.TextRange
End If
Next oCanShp
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
If lngBroke = 0 Then
MsgBox "There are " & lngCountTotal & " reference fields in the active document. All references appear valid.", vbInformation + vbOKOnly, "VALIDATED"
Else
MsgBox lngBroke & " of " & lngCountTotal & " reference fields in the active document could not be validated." & vbCr + vbCr _
& "Invalid fields have been highlighted to assist in resolution.", vbInformation + vbOKOnly, "INVALIDATE FIELDS FOUND"
End If
lbl_Exit:
Exit Sub
End Sub
Function CheckCrossReferences(oRng As Range) As typCRs
Dim oFld As Field
Dim countBroken As Integer
Dim countTotal As Integer
countBroken = 0
countTotal = 0
For Each oFld In oRng.Fields
If oFld.Type = wdFieldRef Then
countTotal = countTotal + 1
On Error Resume Next
oFld.Update
If InStr(oFld.Result, "Error! Ref") > 0 Then
countBroken = countBroken + 1
End If
On Error GoTo 0
If InStr(oFld.Result, "Error! Ref") > 0 Then
oFld.Result.HighlightColorIndex = wdYellow
End If
End If
Next oFld
CheckCrossReferences.Total = countTotal
CheckCrossReferences.Broken = countBroken
lbl_Exit:
Exit Function
End Function