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
 

tweedle

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

Well-known Member
Joined
Aug 1, 2010
Messages
1,559
bump
 

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,714
Office Version
2010
Platform
Windows
I don't think you're going to get that fine-grained control that allows users to move shapes but not resize them.
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
2,554
the link looked like the most promising for seeing what can be done. can you use the API? its not my strong area...
 

tweedle

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

Well-known Member
Joined
Dec 5, 2002
Messages
7,493
Office Version
2016
Platform
Windows
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]
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
2,554
@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?
 

Forum statistics

Threads
1,081,845
Messages
5,361,663
Members
400,643
Latest member
RockStar89

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top