ScreenTips without Hyperlinks

Hi Allen,

Thanks for posting this tip. I was looking for a way to add screentips to acronyms in long documents. The following VBA code assists with automating the process. The macro attempts to find the meaning of the acronym from a glossary table (if present in the document).

Just add the following code to a standard module in the normal .doc and you're off to the races :)
--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub createNote()
'based on https://wordribbon.tips.net/T013230_ScreenTips_without_Hyperlinks
Dim timeStamp As String, bookmarkName As String, screentipText As String
Dim rng As Range
Dim answer As Integer
timeStamp = Format(Now(), "yyyyMMddHHmmss")

If Right(Selection.Text, 1) = Chr(32) Then 'last character is a space
Selection.MoveEnd unit:=wdCharacter, Count:=-1 'remove trailing Space
Set rng = Selection.Range
Else
Set rng = Selection.Range
End If
'
'check for bad bookmark names
If Not InStr(1, Selection.Text, "-", vbTextCompare) = 0 Then
MsgBox "Sorry I can't help you with that one!"
Exit Sub
End If

'assign name of bookmark

bookmarkName = Selection.Text & "_" & timeStamp

'add bookmark
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=bookmarkName
.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]
screentipText = ReplaceinTable(Selection.Text) 'remove non-ascii characters
rng.Select 'restore focus to sending text
screentipText = InputBox(Prompt:="Add hover text:", Default:=screentipText, Title:="Hover Text Maker")

'check fer cancel of inputbox
Select Case StrPtr(screentipText)
Case 0 'Cancel
Exit Sub
Case Else 'continue
End Select




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
End Sub

Function ReplaceinTable(textToFind As String) As String
'http://www.msofficeforums.com/word-vba/28049-vba-table-search-all-Tables-Find-Replace.html

Dim orng As Range
Set orng = ActiveDocument.Range

'if used as sub add inputbox for texttofind
With orng.Find
Do While .Execute(FindText:=textToFind)
If orng.Information(wdWithInTable) Then
orng.Select
Selection.Cells(1).Next.Select
Set orng = Selection.Range
ReplaceinTable = CleanTrim(orng.Text, True)
GoTo lbl_Exit
End If
Loop
End With

lbl_Exit:
Exit Function

End Function

Function CleanTrim(ByVal S As String, Optional ConvertNonBreakingSpace As Boolean = True) As String
'https//www.mrexcel.com/forumfexcel-questions/923725-vba-remove-all-non-printable-special-characters-well-trim.html

Dim X As Long, CodesToClean As Variant
CodesToClean = Array(7, 10, 13) 'bell, carriage return and linefeed

If ConvertNonBreakingSpace Then S = Replace(S, Chr(160), "")
For X = LBound(CodesToClean) To UBound(CodesToClean)
If InStr(S, Chr(CodesToClean(X))) Then S = Replace(S, Chr(CodesToClean(X)), "")
Next
CleanTrim = S
End Function

Now if only we could un-bold the "Ctrl+Click to follow link" from the tip...

Thanks! I have been with Word since 2.0, but there is always something new to learn. On my last assginment, I had Word 2013, but used it only for basic text document production. Here, with Word 2016, I have a mandate to do much more.

MEM

Very helpful. Thanks! You have to wonder why Microsoft wouldn't provide this functionality in Word. Seems like a really good way to include a bit of definition on words or terms (especially acronyms) when writing a document.