Forum Discussion
VBA Code/possible
I have a document where I have tables, figures, and cross-reference tables, figures links to text. Currently, I and my team checks manually if all the links working and going to correct destinations. Such as when click on table 1 it takes it to table 1. This is extensive review and many times we miss it. Can I get help to create VBA code/run macro to check if all the links are working? is it even possible? Add-in tool? thanks and looking forward to have some solution.
3 Replies
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 SubKidd_Ip
Your code may fall a bit short. First, For Each fld in ActiveDocument.Fields WILL NOT process all fields in the document. Second, from experimenting here, the absence of "\h" in the field code will not result in the link not to function.
You may try:
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 FunctionKidd-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
