Attribute VB_Name = "Module_screenTips"
'   screenTips -  Add/Update/Delete a span tag with a title attribute to selected text.
'   Copyright (c) 2002  Stephen C. Travis
'
'   Delete the Title text or hit Cancel to remove the span tag.
'
'   This program is free software; you can redistribute it and/or modify
'   it under the terms of the GNU General Public License as published by
'   the Free Software Foundation; either version 2 of the License, or
'   (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'   or visit their website at http://www.fsf.org/licenses/gpl.txt
'
Sub screenTips()
If Not FrontPage.ActiveDocument Is Nothing Then
If FrontPage.ActivePageWindow.ViewMode = fpPageViewNormal Then
  Dim objTxtRange As IHTMLTxtRange
  Set objTxtRange = ActiveDocument.selection.createRange()
  If Len(objTxtRange.Text) <> 0 Then
  If Right(objTxtRange.Text, 1) = " " Then objTxtRange.moveEnd "character", -1
  Set el = objTxtRange.Duplicate
  el.collapse (True)
  Do Until Tag = "span" Or Tag = "body"
    Set el = el.parentElement
    Tag = el.tagName
  Loop
  If Tag = "span" Then
    InputT = InputBox("Modify (or remove) this screen tip.", "Screen Tip", el.Title)
    If InputT = "" Then
      InputYN = MsgBox("Remove this screen tip?", vbYesNo)
      If InputYN = 6 Then el.outerHTML = el.innerHTML
    Else
      el.Title = InputT
    End If
  Else
    InputT = InputBox("Add a screen tip to the selected text.", "Screen Tip")
    If InputT <> "" Then
      objTxtRange.pasteHTML ("<span title=""" & InputT & """>" & objTxtRange.htmlText & "</span>")
    End If
  End If
  objTxtRange.Select
  Else
    MsgBox ("Screen Tip... adds a span tag with a title" & vbCrLf & "attribute to create popup screen tips." & vbCrLf & vbCrLf & "Please select some text.")
  End If
  Set objTextRange = Nothing
End If
End If
End Sub