resizing and aligning groups of ActiveX controls together

  • Thread starter Thread starter Paul James
  • Start date Start date
P

Paul James

Is there an easy way to make the controls the same height and width with a
single operation on the group?

Also, is there a way to select a group of controls such as Option buttons
and align them together on the left without having to align the individual
controls one by one?

Thank you in advance.
 
Hi Paul,

This was rushed and not adequately tested. Hope no stupid
errors !!! No doubt someone has a more elagent way. In
any event, it demonstrates how I would approach the
problem.

'General method:
Sub AlignControls()
Dim Shp As Shape, ShpRng1 As ShapeRange
Dim ShpRng2 As ShapeRange, ShpRng3 As ShapeRange
Dim X As Integer, i As Integer
Dim ii As Integer, iii As Integer
Dim Ar1() As Variant, Ar2() As Variant, Ar3() As Variant

On Error Resume Next
For Each Shp In ActiveSheet.Shapes
'Increment X with each shape found.
X = X + 1
If Left(Shp.Name, 5) = "Label" Then
'Increment i with each label found.
i = i + 1
'Dimention Ar1 to number of labels.
ReDim Preserve Ar1(i)
'Assign to Ar1 the index value of each label.
Ar1(i) = X
ElseIf Left(Shp.Name, 9) = "Rectangle" Then
'Increment ii with each rectangle found.
ii = ii + 1
'Dimention Ar2 to number of rectangles.
ReDim Preserve Ar2(ii)
'Assign to Ar2 the index value of the rectangles.
Ar2(ii) = X
ElseIf Left(Shp.Name, 12) = "OptionButton" Then
'Increment iii with each option button found.
iii = iii + 1
'Dimention Ar3 to number of option buttons.
ReDim Preserve Ar3(iii)
'Assign to Ar3 the index value of the option buttons.
Ar3(iii) = X
End If
Next

'Define above shapes as respective groups.
Set ShpRng1 = ActiveSheet.Shapes.Range(Ar1)
Set ShpRng2 = ActiveSheet.Shapes.Range(Ar2)
Set ShpRng3 = ActiveSheet.Shapes.Range(Ar3)
'Manipulate as a groups.
ShpRng1.Left = 50
ShpRng2.Left = 120
ShpRng3.Left = 250

On Error GoTo 0
End Sub


'OLEObject specific method:
Sub AlignControls2()
Dim obj As OLEObject
Dim Offset1 As Integer, Offset2 As Integer
Dim Offset3 As Integer, Offset4 As Integer

Offset1 = 0: Offset2 = 0: Offset3 = 0

For Each obj In ActiveSheet.OLEObjects
With obj
'Place common properties here
.Height = 25
.Width = 100
If TypeOf obj.Object Is MSForms.OptionButton Then
'Option button specific properties
.Left = 10
.Top = 100 + Offset1
Offset1 = Offset1 + 35
ElseIf TypeOf obj.Object Is MSForms.Label Then
'Label specific properties
.Left = 150
.Top = 100 + Offset2
Offset2 = Offset2 + 35
ElseIf TypeOf obj.Object Is MSForms.CheckBox Then
'Check box specific properties
.Left = 260
.Top = 100 + Offset3
Offset3 = Offset3 + 35
Else
'Specific properties for all other OLEObjects.
.Left = 10
.Top = 225 + Offset4
Offset4 = Offset4 + 35
End If
End With
Next

End Sub

Regards,
Greg
 
Correction to my post:

I left out the declaration: Option Base 1. Place it at
the top of the module.

Regards,
Greg
 
Thank you for such comprehensive code, Greg. I'll try it out.

I did finally notice what might be an alternate way to do this. If the
shapes are ActiveX objects, I believe this could be done by selecting all
the objects together either by shift-clicking them, or dragging the Select
Objects outline around all the objects, then right-clicking the group,
selecting properties, and setting the appropriate properties (Height, Width,
Left) for the entire group.

It would seem that your code might apply to more than just ActiveX objects,
so that would be an advantage to it.

Thanks again for providing it.
 
Back
Top