xl2000 vs. xl2003 RangeFromPoint and Grouped Shape

[Greg Wilson]

In xl2003, RangeFromPoint returns a grouped shape. It also supports a
ParentGroup property. However, with xl2000, RangeFromPoint returns the group
items instead. And there is no ParentGroup property. I need to return the
grouped shape object for both versions and can't think of an efficient way.

Am I missing something? Ideas, suggestions? Confirmation that I'm S.O.L.
appreciated too.

Greg

 

[Jim Cone]

Greg,
I've never used RangeFromPoint. Maybe...

For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoGroup Then
MsgBox Shp.Parent.Name & vbCr & Shp.Name
End If
Next

-or possibly modify this...

Sub GroupedShapesAreWhere()
Dim Shp As Excel.Shape
Dim shpRng As Excel.ShapeRange
Dim arrShps() As Variant
Dim x As Long
Dim N As Long

For Each Shp In ActiveSheet.Shapes
If Shp.Type = msoGroup Then
x = Shp.GroupItems.Count
ReDim arrShps(1 To x)
For N = 1 To x
arrShps(N) = Shp.GroupItems(N).Name
Next
Set shpRng = ActiveSheet.Shapes.Range(arrShps)
MsgBox shpRng.Parent.Name
End If
Next
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"Greg Wilson"
<[email protected]>
wrote in message
In xl2003, RangeFromPoint returns a grouped shape. It also supports a
ParentGroup property. However, with xl2000, RangeFromPoint returns the group
items instead. And there is no ParentGroup property. I need to return the
grouped shape object for both versions and can't think of an efficient way.

Am I missing something? Ideas, suggestions? Confirmation that I'm S.O.L.
appreciated too.
Greg

 

[Greg Wilson]

Sorry for getting back so late. I had to go to work for a few hours in the
middle of the night.

BACKGROUND:
I have created my own treeview control for a special project. Each node is
composed of a number of grouped shapes. I want to develop a tooltip popup
feature such that holding the mouse pointer over a node displays information
about the node. I run RangeFromPoint in a loop and monitor what's under the
mouse pointer using the GetCursorPosition API function. Don't worry, I only
run the loop temporarily.

PROBLEM:
With xl2000, RangeFromPoint returns the individual group items instead of
the grouped shape (node). When the names are queried, they are the individual
group item shape names (e.g. "Line 241"). xl2000 also does not support the
ParentGroup property. Therefore, I can't think of an efficient means of
determining which grouped shape is under the mouse pointer. There will be
many grouped shapes comprising the treeview.

With xl2003, RangeFromPoint also returns the idividual group items instead
of the grouped shape. But (oddly) when the names are queried, the grouped
shape name is returned. xl2003 also supports the ParentGroup property.
Therefore, I can easily identify the node under the mouse pointer.

DEMO SETUP:
Put a number of shapes on the worksheet from the Drawing toolbar. Then group
them and pretend they represent one of my treeview nodes. Run the following
code.

SIMPLIFIED CODE:

**To exit the loop, move the mouse pointer to the top or left edge of the
screen**

Option Explicit
Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos _
Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Sub xyz()
Dim obj As Object
Dim cpos As POINTAPI
With ActiveWindow
Do
GetCursorPos cpos
Set obj = .RangeFromPoint(cpos.x, cpos.y)
Range("A1").Value = TypeName(obj)
Select Case TypeName(obj)
Case "Range", "Nothing"
With Range("A2")
If .Value <> "" Then .ClearContents
End With
Case Else
Range("A2").Value = obj.Name
End Select
DoEvents
Loop Until cpos.x = 0 Or cpos.y = 0
End With
Set obj = Nothing
End Sub

QUESTION:
In xl2000, how can I efficiently determine what grouped shape is under the
mouse pointer using RangeFromPoint ?

Very appreciative of your time.

Greg





Option Explicit
Type POINTAPI
x As Long
y As Long
End Type
Declare Function GetCursorPos _
Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Sub xyz()
Dim obj As Object
Dim cpos As POINTAPI
With ActiveWindow
Do
GetCursorPos cpos
Set obj = .RangeFromPoint(cpos.x, cpos.y)
Range("A1").Value = TypeName(obj)
Select Case TypeName(obj)
Case "Range", "Nothing"
With Range("A2")
If .Value <> "" Then .ClearContents
End With
Case Else
Range("A2").Value = obj.Name
End Select
DoEvents
Loop Until cpos.x = 0 Or cpos.y = 0
End With
Set obj = Nothing
End Sub

 

[Peter T]

Hi Greg,

I haven't looked at your demo setup but try the following 'as is' for all
versions

As I'm sure you know grouped objects can be in a tree like structure of
groups. I assume you actually want the top level group, which might not be
the parent Group but some generations above. Following should return both
the actual group Parent and the top level group, see Inner & outer most
names in comments.

Sub test()
Dim nz As Long
Dim sName As String, sGroupName As String
Dim obj As Object
Dim gp As GroupObject

' normally Set obj = ActiveWindow.RangeFromPoint(x, y)
' but for testing start with a known object that's grouped,

Set obj = Nothing 'redundant in this test
Set obj = ActiveSheet.Shapes("Rectangle 28")

If Not obj Is Nothing Then
If Not TypeName(obj) = "Range" Then
'presumably a shape
' in xl2000, if grouped returns groupitem, not groupobject
On Error Resume Next
nz = obj.ZOrderPosition
If Err.Number = 70 Then ' permission denied if obj is grouped
' might error for other reasons
' but no harm done ?

sName = obj.Name
For Each gp In ActiveSheet.GroupObjects
GetParentGroup gp.ShapeRange, sName, sGroupName
If Len(sGroupName) Then

'sGroupName = inner most group
'gp.Name = outer most group

Set obj = gp.ShapeRange
Exit For
End If
Next

Err.Clear
End If

On Error GoTo 0
MsgBox obj.Name
End If
End If

End Sub
Function GetParentGroup(gp, sName As String, sParentName As String) As
Boolean
Dim sh As Shape
For Each sh In gp.GroupItems
If sh.Type = msoGroup Then
' recursive
GetParentGroup sh, sName, sParentName
ElseIf sh.Name = sName Then
sParentName = gp.Name
End If

If Len(sParentName) Then
GetParentGroup = True
Exit For
End If
Next

End Function

lightly tested !

Regards,
Peter T

 

[Jim Cone]

Greg,
That is pretty clever coding and I think I may be able to find a use for it.
See if this is close to what you need, it worked on one group...
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)

'--
Sub xyz()
Dim obj As Object
Dim shp As Shape
Dim cpos As POINTAPI
With ActiveWindow
Do
GetCursorPos cpos
Set obj = .RangeFromPoint(cpos.x, cpos.y)
Range("A1").Value = TypeName(obj)
Select Case TypeName(obj)
Case "Range", "Nothing"
With Range("A2")
If .Value <> "" Then Range("A2:A3").ClearContents
End With
Case Else
Range("A2").Value = obj.Name
On Error Resume Next
Set shp = ActiveSheet.Shapes(obj.Name)
If Err.Number = 0 Then
Range("A3").Value = GroupShapesName(shp.Name)
End If
On Error GoTo 0
End Select
DoEvents
Loop Until cpos.x = 0 Or cpos.y = 0
End With
Set obj = Nothing
End Sub
'--

Function GroupShapesName(ByRef strName As String) As String
Dim shp As Shape
Dim x As Long
Dim N As Long

For Each shp In ActiveSheet.Shapes
If shp.Type = msoGroup Then
x = shp.GroupItems.Count
For N = 1 To x
If shp.GroupItems(N).Name = strName Then
GroupShapesName = shp.Name
Exit Function
End If
Next
End If
Next
Set shp = Nothing
End Function
'--




"Greg Wilson" <[email protected]>
wrote in message
Sorry for getting back so late. I had to go to work for a few hours in the
middle of the night.

-snip-
QUESTION:
In xl2000, how can I efficiently determine what grouped shape is under the
mouse pointer using RangeFromPoint ?
Very appreciative of your time.
Greg

 

[Peter T]

Same example combined with your demo. Seems to work for me, ie returns the
'outer most' group name (if a group).

Sub xyz()
Dim obj As Object
Dim cpos As POINTAPI
Dim nz As Long
Dim sName As String, sGroupName As String

Dim gp As GroupObject
With ActiveWindow
Do

GetCursorPos cpos
Set obj = .RangeFromPoint(cpos.x, cpos.y)
Range("A1").Value = TypeName(obj)
Select Case TypeName(obj)
Case "Range", "Nothing"
With Range("A2")
If .Value <> "" Then .ClearContents
End With
Case Else
' in xl2000, if grouped returns groupitem, not groupobject
On Error Resume Next

Set obj = ActiveSheet.Shapes(obj.Name)
nz = obj.ZOrderPosition
If Err.Number = 70 Then ' permission denied if obj is grouped
' might error for other reasons
' but no harm done ?

sName = obj.Name
sGroupName = ""
For Each gp In ActiveSheet.GroupObjects
GetParentGroup gp.ShapeRange, sName, sGroupName
If Len(sGroupName) Then

'sGroupName = inner most group
'gp.Name = outer most group

Set obj = gp.ShapeRange
Exit For
End If
Next
Err.Clear

End If

On Error GoTo 0

Range("A2").Value = obj.Name & " " & sGroupName
sGroupName = "" 'might be better to clear it here
End Select
Set obj = Nothing
DoEvents
Loop Until cpos.x = 0 Or cpos.y = 0
End With
Set obj = Nothing
End Sub

Function GetParentGroup(gp, sName As String, sParentName As String) As
Boolean
Dim sh As Shape
For Each sh In gp.GroupItems
If sh.Type = msoGroup Then
' recursive
GetParentGroup sh, sName, sParentName
ElseIf sh.Name = sName Then
sParentName = gp.Name
End If

If Len(sParentName) Then
GetParentGroup = True
Exit For
End If
Next

End Function

You mentioned something about displaying a tooltip, curiosity how.

Regards,
Peter T

 

[Greg Wilson]

Thanks Jim. I was hoping to avoid loops because of the number of grouped
shapes involved and because the project is already programmatcially massive.
On the bright side, performance is not an issue because a slight delay in
displaying tooltips is designed for anyway. Your's and Peter's code are quite
similar. I plan to adapt this approach because it will also work on later xl
versions.

I'm glad both you and Peter responded because I regard both of you as
genuine experts and this confirms that there is no simple solution. This will
save me a lot of time looking in vane.

Thanks again.

Greg

 

[Jim Cone]

Greg,
You are welcome. Also, I agree with comments about Peter T.
I don't know about that other guy though. <g>
Jim Cone


"Greg Wilson" <[email protected]>
wrote in message
Thanks Jim. I was hoping to avoid loops because of the number of grouped
shapes involved and because the project is already programmatcially massive.
On the bright side, performance is not an issue because a slight delay in
displaying tooltips is designed for anyway. Your's and Peter's code are quite
similar. I plan to adapt this approach because it will also work on later xl
versions.

I'm glad both you and Peter responded because I regard both of you as
genuine experts and this confirms that there is no simple solution. This will
save me a lot of time looking in vane.
Thanks again.

Greg

 

[Greg Wilson]

Thanks Peter for your expert help. See my response to Jim.

To answer your question, I use a large amount of API code to display a
generic "STATIC" window and to time its appearance, disappearance, mouse
pointer tracking, destruction etc. There is also a number of Const
declarations. I think this is all the API code I use:

- CreateWindowEx
- SendMessage
- ShowWindow
- DestroyWindow
- SetWindowPos
- FindWindow
- GetDC
- DeleteDC
- GetDeviceCaps
- CreateFont
- MulDiv
- DeleteObject
- TimeGetTime

As you can appreciate, the code is volumous and not simple. However, it
works nicely with vertually no flicker and still allows macro execution. But
I wouldn't let the loop run indefinately. This would be asking for trouble.

Before I'm jumped on by someone - Yes I know about the method (kludge) of
exploiting the OLE object's mouse_move property, which can be made
dramatically simpler. This is not appropriate for my situation and I avoid
OLE objects (except for MonthView controls) as much as possible.

Thanks again.

Greg







Greg

 

[Peter T]

Sounds like you have a very interesting app !

Regards,
Peter T

Thanks Peter for your expert help. See my response to Jim.

To answer your question, I use a large amount of API code to display a
generic "STATIC" window and to time its appearance, disappearance, mouse
pointer tracking, destruction etc. There is also a number of Const
declarations. I think this is all the API code I use:

- CreateWindowEx
- SendMessage
- ShowWindow
- DestroyWindow
- SetWindowPos
- FindWindow
- GetDC
- DeleteDC
- GetDeviceCaps
- CreateFont
- MulDiv
- DeleteObject
- TimeGetTime

As you can appreciate, the code is volumous and not simple. However, it
works nicely with vertually no flicker and still allows macro execution. But
I wouldn't let the loop run indefinately. This would be asking for trouble.

Before I'm jumped on by someone - Yes I know about the method (kludge) of
exploiting the OLE object's mouse_move property, which can be made
dramatically simpler. This is not appropriate for my situation and I avoid
OLE objects (except for MonthView controls) as much as possible.

Thanks again.

Greg

<snip>