Hover Text #Word

createnote2.bas

Sub createNote2()
'based on https://wordribbon.tips.net/T013230_ScreenTips_without_Hyperlinks
'uses acronym module instead of user inputbox
Dim timeStamp As String, bookmarkName As String, screentipText As String, key As String
Dim rng As Range
Dim answer As Integer
Dim tbl As Table
Application.ScreenUpdating = False
timeStamp = Format(Now(), "yyyyMMddHHmmss")
'On Error GoTo ErrHandler
'establish lookup table (runs longer first time!)
Set lookupDocument = Nothing
Call createAcronymTableFile
'TODO do not proceed to lookup if the table is freshly created
'determine if reference table key values have a trailing space or not.
'adjust lookup string of selected text accordingly (selection may or may not have a trailing space)
Select Case Right(fcnGetCellText(lookupDocument.Tables(1).Cell(1, 1)), 1) 'top left reference cell
    Case Is = Chr(32) 'trailing space
        If Right(Selection.Text, 1) = Chr(32) Then
            key = Selection.Text 'includes trailing space
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
        Else
            key = Selection.Text & Chr(32)
        End If
    Case Else
        If Right(Selection.Text, 1) = Chr(32) Then
            Selection.MoveEnd Unit:=wdCharacter, Count:=-1
            key = Selection.Text 'includes trailing space
        Else
            key = Selection.Text
        End If
End Select
Set rng = Selection.Range
'this prevents bookmark error when initially setting up the reference table
If Selection.Information(wdWithInTable) Then
    If Selection.Cells.Count > 1 Then Exit Sub 'multiple cells were selected
End If
screentipText = acronymDescription(key, lookupDocument.Tables(1))
'On Error GoTo 0
If screentipText = "Value not found" Then
 
    MsgBox screentipText
    Exit Sub
End If
'assign name of bookmark
bookmarkName = rng.Text & "_" & timeStamp
'check for bad bookmark names & correct if necessary [replaced Selection.Text with rng.Text 20190725]
If Not InStr(1, rng.Text, "-", vbTextCompare) = 0 Then 'contains "-"
    bookmarkName = Replace(rng.Text, "-", "", vbTextCompare) & "_" & timeStamp
End If
If Not InStr(1, Selection.Text, "&", vbTextCompare) = 0 Then 'contains "&"
    bookmarkName = Replace(rng.Text, "&", "", vbTextCompare) & "_" & timeStamp
End If
'add bookmark
With ActiveDocument.Bookmarks
    .Add Range:=rng, Name:=bookmarkName 'was Selection.rng
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With
'add hyperlink & screentip [todo: if possible, find adjacent cell to glossary term in table, use to pre-populate tip input]
rng.Select 'restore focus to sending text
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=bookmarkName, ScreenTip:=screentipText, TextToDisplay:= _
        Selection.Text
'remove hyperlink formatting
rng.Select
With Selection.Font
    .ColorIndex = wdAuto
    .Underline = wdUnderlineNone
End With
MsgBox screentipText
Set lookupDocument = Nothing
Application.ScreenUpdating = True
CreateNoteErrHandler:
End Sub