Add Screen Tips to Text in Word

Option Explicit

'=========================
'Macros created 2011 by Lene Fredborg, DocTools - www.thedoctools.com
'THE MACROS ARE COPYRIGHT. YOU ARE WELCOME TO USE THE MACROS BUT YOU MUST KEEP THE LINE ABOVE.
'YOU ARE NOT ALLOWED TO PUBLISH THE MACROS AS YOUR OWN, IN WHOLE OR IN PART.    
'=========================
'See the comments in the individual macros
'=========================

'Constants used by the procedures below - you may change the values
'Used when naming bookmarks:
Public Const cstrBKStart = "_ScreenTip_"

'Used for messages:
Public Msg As String
Public Title As String
Public Style As VbMsgBoxStyle
Public Response As VbMsgBoxResult

Sub AddScreenTipToText()

    'Created 2011 by Lene Fredborg, DocTools - www.thedoctools.com
    
    'The macro converts selected text to a hyperlink that shows
    'the screen tip text you specify when a user hovers the mouse over the text.
    'In order to make it easy for the user to identify text with screen tips,
    'a shading color is applied to the text.
    'For further details, see the comments below.

    Dim oRange As Range
    Dim strBK As String
    Dim oHL As Hyperlink
    Dim strScreeenTip As String
    Dim oColor As WdColor
    Dim strScreenTip As String
    Dim strLineSeparator As String
    
    Title = "Add Screen Tip to Selection (Max. 255 Characters)"
    
    'The color specified below will be applied to the selected text
    'You can change the color if you wish
    oColor = wdColorLightTurquoise
    
    'The string specified below can be used to specify a line break
    'in the screen tip text
    'If you need the specified character to be included in the screen tip text as such,
    'change the character to something that will not be used in the screen tip texts
    strLineSeparator = "#"
    
    'Stop if no text is selected
    If Selection.Type = wdSelectionIP Then
        Msg = "Please select the text to which you want to apply a screen tip. Then select this command again."
        MsgBox Msg, vbOKOnly, Title
        Exit Sub
    End If
    
    'Stop if a hyperlink is in the selection
    If Selection.Hyperlinks.Count > 0 Then
        Msg = "The selection already contains hyperlink(s). No changes will be made."
        MsgBox Msg, vbOKOnly, Title
        Exit Sub
    End If
    
    'Let user specify screen tip text
Retry:
    Msg = "This command lets you change the selection so that a screen tip appears if a user hovers the mouse over the text." & vbCr & vbCr & _
            "The command converts the selected text to a hyperlink. In order to make the selection remain unchanged if a user " & _
            "clicks the hyperlink, a bookmark will be added around the hyperlink itself and the " & _
            "hyperlink will be defined to go to that bookmark is the user clicks it. Shading will be applied to the hyperlinked text. " & _
            "in order to make it easy for the user to identify text with screen tips." & vbCr & vbCr & _
            "Please enter the screen tip text you want to appear when the user hovers the mouse over the selected text " & _
            "(to indicate a line break, type " & strLineSeparator & "):"
        
    strScreenTip = InputBox(Msg, Title)

    If Len(strScreenTip) = 0 Then
        If StrPtr(strScreenTip) = 0 Then
            'Cancel clicked
            Exit Sub
        Else
            'OK clicked, empty field
            Msg = "You must enter the desired sceen tip text. Please retry."
            Style = vbOKOnly + vbInformation
            Response = MsgBox(Msg, Style, Title)
            GoTo Retry
        End If
    Else
        'Input accepted
        'Replace any strLineSeparator in the screen tip with vbCr
        strScreenTip = Replace(strScreenTip, strLineSeparator, vbCr)
        
        Set oRange = Selection.Range
        
        'Add bookmark around oRange
        strBK = GetBookmarkName
        oRange.Bookmarks.Add Name:=strBK
        
        'Convert selection to hyperlink
        Set oHL = oRange.Hyperlinks.Add(Anchor:=oRange, Address:="", SubAddress:=strBK)
        With oHL
            .ScreenTip = strScreenTip
            With .Range
                'Reset font to remove the hyperlink style (default: blue and underlined)
                'If your document is not formatted with proper styles,
                'you may need to change the following code
                .Font.Reset
                .Shading.BackgroundPatternColor = oColor
                'Make sure the shading stops after the range
                .Start = .End
                .Font.Reset
            End With
        End With
    End If
    
    'Make sure screen tips are shown
    Application.DisplayScreenTips = True
    
    'Clean up
    Set oRange = Nothing
    Set oHL = Nothing

End Sub

Function GetBookmarkName() As String
    
    'Created 2011 by Lene Fredborg, DocTools - www.thedoctools.com
    
    'Function used by the AddScreenTipToText macro.
    'Creates a unique bookmark name in the format "_ScreenTip_X"
    
    Dim n As Long
    
    n = 1
    
    Do Until ActiveDocument.Bookmarks.Exists(cstrBKStart & n) = False
        n = n + 1
    Loop
    
    GetBookmarkName = cstrBKStart & n
End Function

Sub RemoveScreenTipFromText()
    'Removes hyperlink added to text using the AddScreenTipToText macro
    'The cursor must be in the hyperlink or the selection must include the hyperlink
    
    Title = "Remove Screen Tip From Selection"
    
    'Stop if not precisely 1 hyperlink is in the selection
    If Selection.Hyperlinks.Count <> 1 Then
        Msg = "You must first click in or select a single hyperlink that has been added " & _
            "via the AddScreenTipToText macro. Please retry."
        MsgBox Msg, vbOKOnly, Title
        Exit Sub
    End If
    
    With Selection.Hyperlinks(1)
        If InStr(1, .SubAddress, cstrBKStart) > 0 Then
            'Remove background color
            .Range.Shading.BackgroundPatternColor = wdColorAutomatic
            'Remove hyperlink, i.e. convert to normal text
            .Delete
        End If
    End With
    
End Sub