And if someone else will be using this technique I need to add that you need
to put the text first on a line first, then do the check, and then move it
back as desired. Otherwise you might get undesired results since a hyperlink
in running text can wrap also when it is not as long as a line and then it
would still work in a macrobutton field.
Here is some code in case someone wants it (perhaps overly complex for
general use, but due to the rest of my application I need it to look this
way):
' insertionRange contains the text in question and is part of
' the range macroButtonField.Code i.e. { macrobutton macro <insertionRange> }
Private Sub InsertLinkInMacroButtonField(insertionRange As Range,
macroButtonField As Field, address As String)
Dim oldSelection As Range
Dim hl As Word.Hyperlink
Dim hlRange As Range
Dim rng As Range
Dim rngToRemove As Range
Set oldSelection = Selection.Range.Duplicate
' Cut and paste insertion Range to a new fresh line, check if it is
wrapping and
' if so truncate and copy back
Set rng = GetFieldRange(macroButtonField)
rng.Collapse wdCollapseStart
rng.insertBefore vbCr & vbCr
Set rngToRemove = rng.Duplicate
rng.Collapse wdCollapseStart
rng.MoveStart wdCharacter, 1
insertionRange.Cut
rng.Paste
rng.Select
Dim truncated As Boolean
Dim rngToTruncate As Range
truncated = False
While Selection.End > evDoc.Bookmarks("\Line").Range.End And
Len(rng.text) >= 1
'Selection is too long
Set rngToTruncate = rng.Duplicate
rngToTruncate.Start = rngToTruncate.End - 1
rngToTruncate.text = ""
truncated = True
Wend
If truncated And (Len(rng.text) >= 3) Then
Set rngToTruncate = rng.Duplicate
rngToTruncate.Start = rngToTruncate.End - 3
rngToTruncate.text = "..."
rng.End = rngToTruncate.End
End If
' cut and paste rng back, insert hyperlink, remove extra characters at
range
rng.Cut
insertionRange.Paste
rngToRemove.text = ""
insertionRange.Hyperlinks.Add insertionRange, address
oldSelection.Select
end sub
Public Function GetFieldRange(f As Field) As Range
Dim rng As Range
Set rng = f.Code.Duplicate
rng.TextRetrievalMode.IncludeFieldCodes = True
rng.TextRetrievalMode.IncludeHiddenText = True
rng.Start = rng.Start - 1
rng.End = rng.End + 1
Set GetFieldRange = rng
End Function
