Excel Excel 2007 -RangeFromPoint not working for shapes

E

excelthoughts

Joined
Aug 22, 2008
Messages
4
Reaction score
0
I have some code that works for Excel 2003, but not for Excel 2007.
It invoves checking the Cursor Location to check whether there is a shape under it and displaying a tooltip.
Worksw under Excel 2003, but not under 2007.
2007 seems to treat everything as a Range, even if the cursor is over a Shape.

Anyone know why?


Set up required to reproduce the problem:

1- Place a TextBox (TextBox1) on sheet1 .
2- Place any number of AutoShapes on the same sheet.
3- Add 2 Buttons and assingn to them respectively the StartToolTip and the StopToolTip Procedures.


Code:

Place this in the Workbook Module:

Code: 
	Private Sub Workbook_Open()
   
       Sheets(1).TextBox1.Visible = False
   
   End Sub
Place this code in the Worksheet Module:

Code: 
	Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
       TextBox1.Visible = False
   
   End Sub
Place this code in a Standard Module :

Code: 
	Option Base 1
   Option Explicit
   
   Private Declare Function SetTimer Lib "user32" _
   (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, _
   ByVal lpTimerFunc As Long) As Long
   
   Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _
   ByVal nIDEvent As Long) As Long
   
   Private lTimerID As Long
   
   Private Type POINTAPI
     X As Long
     Y As Long
   End Type
   
   Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
   
   Private oToolTip As Object
   Private ShapesArr() As String
   
   Sub StartToolTip()
   
       CreateToolTip Sheets(1)
       GetTargetShapes Sheets(1)
       StartCursorWatch
   
   End Sub
   
   Sub StopToolTip()
   
       KillTimer 0, lTimerID
       oToolTip.Visible = False
   
   End Sub
   
   
   Private Sub CreateToolTip(ws As Object)
   
       Set oToolTip = ws.TextBox1
       oToolTip.Visible = False
       
   End Sub
   
   Private Sub GetTargetShapes(ByVal ws As Worksheet)
   
       Dim oShp As Shape
       Dim i As Byte
   
       For Each oShp In ws.Shapes
           If oShp.Type = 1 Then
               i = i + 1
               ReDim Preserve ShapesArr(i)
               ShapesArr(i) = oShp.Name
               oShp.OnAction = "Hello"
           End If
       Next
   
   End Sub
   
   Private Sub StartCursorWatch()
   
       lTimerID = SetTimer(0, 0, 100, AddressOf TimerCallBack)
   
   End Sub
   
   Private Sub TimerCallBack()
   
       Dim tCurPos As POINTAPI
       Dim oRangeFromPoint As Object
       Dim bFlag As Boolean
       Static oPrev As Object
       
       On Error Resume Next
       GetCursorPos tCurPos
       Set oRangeFromPoint = ActiveWindow.RangeFromPoint(tCurPos.X, tCurPos.Y)
       With oRangeFromPoint
           If TypeName(oRangeFromPoint) <> "Range" Then
               If oPrev.Name <> .Name And .Name <> oToolTip.Name Then
               Set oPrev = oRangeFromPoint
               bFlag = WorksheetFunction.Match(.Name, ShapesArr(), 0) >= 1
                   If bFlag Then
                       bFlag = Null
                       FormatAndShowToolTip oToolTip, oRangeFromPoint
                   End If
               End If
           ElseIf oToolTip.Visible = True Then
               oToolTip.Visible = False
           Else
               Set oPrev = Nothing
           End If
       End With
   
   End Sub
   
   Private Sub FormatAndShowToolTip(t As Object, ByVal s As Object)
   
      ' Dim sText As String
       Const sText = "Top line numbers for  "
       Const bRept = 10
       Dim iFarRightColumn As Integer
   
       With t.Object
           .Text = Application.WorksheetFunction.Rept _
           (sText & s.Name & "... -  ", bRept)
           .MultiLine = True
           .AutoSize = True
           t.Width = 220
           .SpecialEffect = 1 '0
           .BackColor = 12648447
           .WordWrap = True
           .Font.Size = 8
           .BorderStyle = 1
           .Locked = True
           .ForeColor = vbRed
           iFarRightColumn = _
           ActiveWindow.ScrollColumn + _
           ActiveWindow.VisibleRange.Columns.Count
           If iFarRightColumn - s.TopLeftCell.Column <= 5 Then
               t.Left = s.TopLeftCell.Offset(, -2).Left
               t.Top = s.BottomRightCell.Offset(1).Top
           Else
               t.Left = s.BottomRightCell.Offset(1).Left
               t.Top = s.BottomRightCell.Offset(1).Top
           End If
           .Text = Application.WorksheetFunction.Rept _
           (sText & s.Name & "... -  ", bRept)
           t.Visible = True
       End With
   
   End Sub
   
   Private Sub Hello()
   
       MsgBox "Hello from " & Application.Caller
   
   End Sub

Now, open workbook in Excel 2003. Should work. Open in Excel 2007. Doesn't work.

Regards.
Andrew
 
Last edited:
Back
Top