Lock my shapes from user resizing

tweedle

Well-known Member
Joined
Aug 1, 2010
Messages
1,559
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

Code:
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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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.
 
Upvote 0
I don't think you're going to get that fine-grained control that allows users to move shapes but not resize them.
 
Upvote 0
the link looked like the most promising for seeing what can be done. can you use the API? its not my strong area...
 
Upvote 0
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.
 
Upvote 0
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 :

Code:
[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]
 
Upvote 0
@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?
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top