View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Greg Wilson Greg Wilson is offline
external usenet poster
 
Posts: 747
Default 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