Default Excel 2007 -RangeFromPoint not working for shapes

E

excelthoughts

I have some code that works for Excel 2003, but not for Excel 2007.
It involves monitoring the Cursor Location to check whether there is a Shape
under it and displaying a tooltip if there is.

Excel 2007 seems to treat everything under Cursor as a Range, even if the
cursor is over a Shape.

I have put VBA code (rather than C#) here as I initially thought that it was
an issue with the Excel 2007 Addin I created using Visual Studio 2008.
However, code fails in VBA and C#.

Set up required to reproduce the problem (VBA code):

1- Place a TextBox (TextBox1) on sheet1 .
2- Place any number of AutoShapes on the same sheet.
3- Add 2 Buttons and assigning 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 CommandButton1_Click()
StartToolTip
End Sub

Private Sub CommandButton2_Click()
StopToolTip
End Sub

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
If Not oToolTip Is Nothing Then
oToolTip.Visible = False
End If

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 Not oRangeFromPoint Is Nothing And TypeName(oRangeFromPoint) <>
"OLEObject" And 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.

Anyone know why this is happening, or another workaround?
I know I could sort of get the position of each shape using
Range(shape.TopLeftCell, shape.BottomRightCell)), but it is not very
accurate, especially when there are shapes close to each other/overlapping.


Regards.
Andrew
 
N

Nick Hebb

I have some code that works for Excel 2003, but not for Excel 2007.
It involves monitoring the Cursor Location to check whether there is a Shape
under it and displaying a tooltip if there is.

Excel 2007 seems to treat everything under Cursor as a Range, even if the
cursor is over a Shape.

I have put VBA code (rather than C#) here as I initially thought that it was
an issue with the Excel 2007 Addin I created using Visual Studio 2008.
However, code fails in VBA and C#.

Set up required to reproduce the problem (VBA code):

1- Place a TextBox (TextBox1) on sheet1 .
2- Place any number of AutoShapes on the same sheet.
3- Add 2 Buttons and assigning 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 CommandButton1_Click()
StartToolTip
End Sub

Private Sub CommandButton2_Click()
StopToolTip
End Sub

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
    If Not oToolTip Is Nothing Then
        oToolTip.Visible = False
    End If

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 Not oRangeFromPoint Is Nothing And TypeName(oRangeFromPoint) <>
"OLEObject" And TypeName(oRangeFromPoint) <> "Range" Then
            If oPrev.Name <> .Name And .Name <> oToolTip.NameThen
            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.

Anyone know why this is happening, or another workaround?
I know I could sort of get the position of each shape using
Range(shape.TopLeftCell, shape.BottomRightCell)), but it is not very
accurate, especially when there are shapes close to each other/overlapping.

Regards.
Andrew
Click to expand...

I tried this out, and confirmed your findings. I added
Application.StatusBar = TypeName(oRangeFromPoint) right after the line
where it's set. It showed the correct objects in Excel 2003 but not
2007. Looks like you'll have to find a workaround.

- Nick Hebb
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Making a macro only work on certain files 2
Remove Identical words 0
Word macro that can call cells out of Excel for a find and replace 0
VBA Coding Help for Beginner 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
VBA for Dependents shortcut menu 0
converting VBA password-masking code to 64-bit 0
Prompt For Replace in Selection And More... 0

Top