Outlook Forum

Members

Help

Outlook Forum

Today's Messages (ON) | Unanswered Messages (OFF)

Forum: Developer Outlook add-ins

Topic: Default Excel 2007 -RangeFromPoint not working for shapes

Default Excel 2007 -RangeFromPoint not working for shapes [message #399539]

Wed, 27 August 2008 01:22

excelthoughts
Messages: 2
Registered: August 2006
Location: NULL

Junior Member

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

All about Microsoft Office Outlook