Word VBA实战应用：给文本添加屏幕提示

标签：Word VBA

本文提供的Word VBA程序可以在Word中制作类似网站中的屏幕提示，即将鼠标悬停在特定文本上时显示包含相关信息的小框。你可以使用这类屏幕提示来显示术语的定义、提示该段文本的特殊作用，等等。

Word没有专门实现这种需求的功能，但可以使用超链接来实现类似的需求。如果这样的话，你必须依次执行选择文本、添加书签、创建超链接、选择书签、输入屏幕提示文本等操作。

下面是一组自动执行这些操作的VBA程序。

AddScreenTipForText过程允许以结构化的方式添加屏幕提示超链接。RemoveScreenTipFromText过程允许根据需要轻松删除屏幕提示超连接。GetBookmarkName过程用于给所选文本创建唯一书签以便添加屏幕提示。

程序代码如下：

代码语言：javascript复制

'声明下面程序使用的常量
Public Const cstrBKStart = "_ScreenTip_"
'用于消息：
Public Msg As String
Public Title As String
Public Style As VbMsgBoxStyle
Public Response As VbMsgBoxResult

'下面的程序将选择的文本转换成超链接
'以在用户鼠标放置在该文本上时显示特定的屏幕提示.
'为了让用户容易识别带有屏幕提示的文本,
'给这些文本应用了背景色.
Sub AddScreenTipForText()
 Dim objRange As Range
 Dim strBK As String
 Dim objHL As Hyperlink
 Dim objColor As WdColor
 Dim strScreenTip As String
 Dim strLineSeparator As String

 Title = "给所选内容添加屏幕提示(最多255个字符)"

'指定应用到所选文本的颜色
'你可以修改为你喜欢的颜色
 objColor = wdColorViolet

'下面指定的字符串用于指定屏幕提示文本中的换行符.
'如果指定的字符会包含在屏幕提示文本中，
'那么将该字符更改为屏幕提示文本中不使用的字符.
 strLineSeparator = "#"

'如果没有选择文本则停止
 If Selection.Type = wdSelectionIP Then
   Msg = "请选择要应用屏幕提示的文本.然后再运行程序."
   MsgBox Msg, vbOKOnly, Title
   Exit Sub
 End If

'如果选择内容有超链接则停止
 If Selection.Hyperlinks.Count > 0 Then
   Msg = "所选内容已经包含超链接.将不会作任何改变."
   MsgBox Msg, vbOKOnly, Title
   Exit Sub
 End If

 '让用户指定屏幕提示文本
Retry:
  Msg = "本程序允许更改所选内容, 以便在用户将鼠标悬停在文本上时显示屏幕提示." & vbCr & vbCr & _
        "转换所选文本为超链接." & _
        "为了当用户单击超链接时保持所选内容不变,将在超链接自身添加书签并且超链接将被定义到转向该书签." & _
        "对超链接文本应用背景色, 以便使用户容易识别包含屏幕提示的文本." & vbCr & vbCr & _
        "请输入用户鼠标放置在所选文本上时你想显示的屏幕提示文本" & _
        "(要表示换行符, 输入" & strLineSeparator & "):"

 strScreenTip = InputBox(Msg, Title)

 If Len(strScreenTip) = 0 Then
   If StrPtr(strScreenTip) = 0 Then
     '单击“取消”
     Exit Sub
   Else
     '单击“确定”,空字段
     Msg = "必须输入想要的屏幕提示文本. 请重试."
     Style = vbOKOnly   vbInformation
     Response = MsgBox(Msg, Style, Title)
     GoTo Retry
   End If
 Else
  '输入已接受
  '用vbCr替换屏幕提示中的任何strLineSeparator
  strScreenTip = Replace(strScreenTip, strLineSeparator, vbCr)

  Set objRange = Selection.Range

  '给objRange添加书签
  strBK = GetBookmarkName
  objRange.Bookmarks.Add Name:=strBK

  '转换所选内容为超链接
  Set objHL = objRange.Hyperlinks.Add(Anchor:=objRange, Address:="", SubAddress:=strBK)
  With objHL
    .ScreenTip = strScreenTip
    With .Range
     '重设字体以移除超链接样式（默认带下划线的蓝色）
     '如果你的文档没有使用合适的样式格式,可能需要更改以下代码
     .Font.Reset
     .Shading.BackgroundPatternColor = objColor
     '确保背景色在该区域后停止
     .Start = .End
     .Font.Reset
    End With
   End With
 End If

 '确保显示屏幕提示
 Application.DisplayScreenTips = True

 '清理
 Set objRange = Nothing
 Set objHL = Nothing
End Sub

'以"_ScreenTip_X"格式创建唯一的书签名
Function GetBookmarkName() As String
 Dim n As Long

 n = 1

 Do Until ActiveDocument.Bookmarks.Exists(cstrBKStart & n) = False
   n = n   1
 Loop

 GetBookmarkName = cstrBKStart & n
End Function

'移除AddScreenTipForText过程对文本添加的超链接
'光标必须处于超链接中或者所选内容必须包括超链接
Sub RemoveScreenTipFromText()
 Title = "从所选内容中删除屏幕提示"

 '如果所选内容中不是只有一个超链接则停止
 If Selection.Hyperlinks.Count <> 1 Then
   Msg = "必须首先单击或选择已添加的单个超链接.请重试."
   MsgBox Msg, vbOKOnly, Title
   Exit Sub
 End If

 With Selection.Hyperlinks(1)
   If InStr(1, .SubAddress, cstrBKStart) > 0 Then
    '删除背景色
    .Range.Shading.BackgroundPatternColor = wdColorAutomatic
    '删除超链接
    .Delete
   End If
 End With
End Sub

要添加屏幕提示，首先选择要添加屏幕提示的文本，然后运行AddScreenTipForText过程，此时会弹出一个对话框，输入你想显示的屏幕提示，单击“确定”。此时，当用户将鼠标悬停在所选文本上时，输入的文本将显示在屏幕提示中。文本也应用了指定的背景色，以便于用户容易识别包含有屏幕提示的文本。而正常的超链接样式将自动从超链接中删除，以便用户可以将屏幕提示超链接与普通超链接区分开来。如果需要，可以更改程序中背景色的颜色。如果想将屏幕提示多行显示，可以在需要换行的地方输入换行符（示例中为“#”）。

要删除屏幕提示，选择相应的文本，然后运行RemoveScreenTipFromText过程。

vba

0 人点赞