特定のブックマークへの相互参照の検索（Microsoft Word）

{ REF MyBookmark \h }

{ REF _Ref47603047 \h }

Sub IsBookmarkReferenced()

Dim aStory As Range     Dim aShape As Shape     Dim aField As Field     Dim bkName As String     Dim bReffed As Boolean

bReffed = False     If Selection.Bookmarks.Count > 0 Then         bkName = Selection.Bookmarks(1).Name         For Each aStory In ActiveDocument.StoryRanges             If TestForBookmark(aStory, bkName) Then                 bReffed = True             Else                 Select Case aStory.StoryType                     Case wdMainTextStory, wdEvenPagesHeaderStory, _                       wdPrimaryHeaderStory, wdEvenPagesFooterStory, _                       wdPrimaryFooterStory, wdFirstPageHeaderStory, _                       wdFirstPageFooterStory                         For Each aShape In aStory.ShapeRange                             If aShape.TextFrame.HasText Then                                 If TestForBookmark(aShape.TextFrame.TextRange, bkName) Then bReffed = True                             End If                         Next                     End Select                 Next aStory             Endif         Next aStory         sTemp = "Bookmark " & bkName & " is "

If Not bReffed Then sTemp = sTemp & "NOT "

sTemp = sTemp & "referenced in the document."

Else         sTemp = "There is no bookmark in the selected text."

End If     MsgBox sTemp End Sub

Function TestForBookmark(tRange As Range, bkName As String) As Boolean     Dim aField As Field

TestForBookmark = True     For Each aField In tRange.Fields         Select Case aField.Type             Case wdFieldRef, wdFieldAsk, wdFieldBarCode, _               wdFieldGoToButton, wdFieldHyperlink, _               wdFieldNoteRef, wdFieldPageRef, wdFieldSet                 If BookRef(aField.Code.Text, aField.Type) = bkName Then Exit Function             Case wdFieldTOC, wdFieldTOA                 If TOCRef(aField.Code.Text) = bkName Then Exit Function         End Select     Next aField     TestForBookmark = False End Function

Function BookRef(str As String, typeCode As Long) As String     Dim s As String     Dim i As Long

s = Trim(str)

If s <> "" Then         i = InStr(s, " ")

If i > 0 Then s = Trim(Mid(s, i))

If typeCode = wdFieldHyperlink Then             If InStr(s, "\l") > 0 Then                 s = Mid(s, InStr(s, """") + 1)

i = InStr(s, """")

If i > 1 Then s = Left(s, i - 1)

Else                 s = ""

End If         Else             i = InStr(s, " ")

If i > 0 Then s = Trim(Left(s, i))

End If     End If     BookRef = s End Function

Function TOCRef(str As String) As String     Dim s As String     Dim i As Long

s = Trim(str)

i = InStr(s, "\b")

If i = 0 Then         TOCRef = ""

Exit Function     End If     s = Trim(Mid(s, i + 2))

i = InStr(s, " ")

If i > 0 Then s = Left(s, i - 1)

TOCRef = s End Function