xl2000 vs. xl2003 RangeFromPoint and Grouped Shape
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" wrote:
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
"Peter T" <peter_t@discussions wrote in message
...
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
"Greg Wilson" 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
|