13
« on: October 23, 2006, 02:42:31 am »
We have achieved this with RTF bookmarks:
1. Copy the RTF bookmark of the element you want to link to (on the right-click menu).
2. Paste the bookmark into your text.
We have written a Word macro that converts these into hyperlinked references:
Sub PostProcess()
'
' PostProcess Macro
' Macro recorded 02/10/2006 by RSO
'
Dim txt As String
Dim cont As Boolean
Dim start As Long, laststart As Long
cont = True
laststart = 0
Do While cont
txt = GetNextRef(start)
If txt <> "" Then
txt = ProcessBookmark(txt)
If IsBookmark(txt) Then
Selection.TypeText ("page ")
Selection.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
wdPageNumber, ReferenceItem:=txt, InsertAsHyperlink:=True, _
IncludePosition:=False
Else
Selection.TypeText ("{BOOKMARK NOT DEFINED}")
End If
'ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
' SubAddress:=txt, ScreenTip:="", TextToDisplay:="Click here"
If (start < laststart) Then
cont = False
End If
laststart = start
Else
cont = False
End If
Loop
End Sub
Function IsBookmark(txt As String) As Boolean
Dim i As Integer
IsBookmark = False
For i = 1 To ActiveDocument.Bookmarks.Count
If ActiveDocument.Bookmarks.Item(i) = txt Then
IsBookmark = True
Exit Function
End If
Next
End Function
Function ProcessBookmark(txt As String)
Dim i As Long
If (Left(txt, 4) <> "BKM_") Then
txt = "BKM_" & txt
End If
' Replace all "-" with "_"'s dur bug in Enterprise Architect
i = 1
Do While (i <= Len(txt))
If Mid$(txt, i, 1) = "-" Then
Mid$(txt, i, 1) = "_"
End If
i = i + 1
Loop
ProcessBookmark = txt
End Function
Function GetNextRef(ByRef start As Long) As String
Dim txt As String
Dim Last As String
Dim cont As Boolean
Selection.Find.ClearFormatting
With Selection.Find
.Text = "{"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
cont = True
Do While cont
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Last = Right$(Selection.Text, 1)
If (Last = "}") Then
cont = False
End If
Loop
GetNextRef = Mid$(Selection.Text, 2, Len(Selection.Text) - 2)
start = Selection.start
Else
start = 0
GetNextRef = ""
End If
End Function