Lock my shapes from user resizing

[tweedle]

So I'm creating a bunch of shapes via vba that need to maintain their size as created, but allow the user to drag around (move) if need.
I've been digging through shape properties and ShapeNodes but haven't found how to lock the shape from resizing.

I need some direction/examples ... if this is possible.

TIA

Sub foo()
'basic idea... 
    vleft = 0
    vtop = 0
    gwidth = 40
    gheight = 40
    bwidth = 50
    bheight = 50

    Set shp1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, vleft + 5, vtop + 5, gwidth, gheight)
    shp1.Fill.ForeColor.RGB = RGB(0, 0, 166)

    Set shp2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, vleft, vtop, bwidth, bheight)
    shp2.Fill.ForeColor.RGB = RGB(0, 255, 0)
    shp2.ZOrder msoBringToFront
    shp2.ZOrder msoSendBackward

    Dim shpgrp As Shape
    Set shpgrp = ActiveSheet.Shapes.Range(Array(shp1.Name, shp2.Name)).Group
End Sub

 

[diddi]

have a look at this...

http://newtonexcelbach.wordpress.com/2008/09/17/drawing-in-excel-6-getting-shape-properties/

 

[tweedle]

tks for the reply; if vba exposed a property bag, that entire exercise would be moot.
Didn't see where it helps lock shapes from resizing though.

 

[tweedle]

bump

 

[tweedle]

bump

 

[shg]

I don't think you're going to get that fine-grained control that allows users to move shapes but not resize them.

 

[diddi]

the link looked like the most promising for seeing what can be done. can you use the API? its not my strong area...

 

[tweedle]

The wb on the link had a udf that listed out properties (in a rather odd way).
I'm resolved that shg is right in that I won't control the actual sizing ability.
I am already tracking the objects and dimensions in an array, so I'll either trap a resize somehow and just deal with the shape being touched, or I'll cycle through them all and size to spec., or try to get into the undo buffer and read that.

diddi and shg; Thanks for your input. Always appreciated.

 

[Jaafar Tribak]

I gave this a try by using the GetCursor API to detect when the user is about to resize the shape and act accordingly but even that didn't work as it seems that the handle to the cursor changes all the time.

The only workaround that I see possible is to continiously check the width & height of the shape in the background and perform an Undo if either of the dimensions change. I would suggest to avoid using a loop or a timer. Use instead the commandbars On_Update event. It is less heavy.

Something along these lines maybe :

[B][COLOR=Red]Private WithEvents cmb As CommandBars[/COLOR][/B]

[COLOR=Red][B]Private shpgrp As Shape[/B][/COLOR]
[B][COLOR=Red]Private Wd As Long[/COLOR][/B]
[B][COLOR=Red]Private Hg As Long[/COLOR][/B]

 Sub shapess()
'basic idea...
    vleft = 0
    vtop = 0
    gwidth = 40
    gheight = 40
    bwidth = 50
    bheight = 50

    Set shp1 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, vleft + 5, vtop + 5, gwidth, gheight)
    shp1.Fill.ForeColor.RGB = RGB(0, 0, 166)

    Set shp2 = ActiveSheet.Shapes.AddShape(msoShapeRectangle, vleft, vtop, bwidth, bheight)
    shp2.Fill.ForeColor.RGB = RGB(0, 255, 0)
    shp2.ZOrder msoBringToFront
    shp2.ZOrder msoSendBackward

    Set shpgrp = ActiveSheet.Shapes.Range(Array(shp1.Name, shp2.Name)).Group
    
    [B][COLOR=Red]Wd = shpgrp.Width
     Hg = shpgrp.Height[/COLOR][/B]
    
    [B][COLOR=Red]Set cmb = Application.CommandBars[/COLOR][/B]
  
  
End Sub

[COLOR=Red][B]Private Sub cmb_OnUpdate()

    If shpgrp.Width <> Wd Or _
    shpgrp.Height <> Hg Then _
    Application.Undo: MsgBox "Can't resize shape."

End Sub[/B][/COLOR]

 

[diddi]

@jafaar
you have taken a path i didnt think of...
what about using the API to draw the shape?
that gives a handle which wont change, doesnt it?