see above
1 2 3
Dim s As Shape Set s = ActiveShape If s.Type = cdrContourGroupShape Then MsgBox "This shape has a contour...", , "Test Contour"
This should do what (I understood) you need...
Private Sub GlobalMacroStorage_SelectionChange() Dim s As Shape, eff As EffectContour, contR As ShapeRange Set s = ActiveShape If s.Effects.Count > 0 Then For i = 1 To s.Effects.Count If s.Effects(i).Type = cdrContour Then Set eff = s.Effects(i).Contour Set contR = ActiveDocument.CreateShapeRangeFromArray(eff.ContourGroup, s) contR.AddToSelection End If Exit For Next i End If End Sub
It works for me (X8) for click, drop and right click. I did not test something else...
In the meantime checked also Ctrl + D and hitting the plus sign and also works. X8
Myron said:That's awesome FaneDuru! Only trouble is that it errors out if clicking on the workspace Needs an "If No selection then exit sub"?
Strange...
In my X8 it works well. 'If Not s Is Nothing' does exactly that. It goes on only if a shape is selected...
Where did you receive the error? I mean in which line?
Is it possible that X7 behaves different on such a simple code? Maybe it does not allow to a range to be considered a shape (in case of multiple selection). X8 does...
Myron said:
This was the first one, just to check if my approach works...
After that I delivered a workable one working only if there is something selected.