Good afternoon all,
I am working on a Spreadsheet that will generate rectangles of a specified dimension which I can then manipulate to see if they will fit within a certain, predetermined, area. This will assist me with load planning for lorries.
I have the code worked out to create the rectangles (in different colours) but what I cannot do is amend the rectangle dimensions and have the macro resize the rectangles.
The code for the rectangles is as follows and I have attached the workbook:
Any and all help is gratefully appreciated
>>> use code - tags <<<
I am working on a Spreadsheet that will generate rectangles of a specified dimension which I can then manipulate to see if they will fit within a certain, predetermined, area. This will assist me with load planning for lorries.
I have the code worked out to create the rectangles (in different colours) but what I cannot do is amend the rectangle dimensions and have the macro resize the rectangles.
The code for the rectangles is as follows and I have attached the workbook:
Any and all help is gratefully appreciated
>>> use code - tags <<<
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D2")) Is Nothing Then
ActiveSheet.Shapes("Boiler").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E2")) Is Nothing Then
ActiveSheet.Shapes("Boiler").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D3")) Is Nothing Then
ActiveSheet.Shapes("Eco Line").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E3")) Is Nothing Then
ActiveSheet.Shapes("Eco Line").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
ActiveSheet.Shapes("Maintenance Platform").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E4")) Is Nothing Then
ActiveSheet.Shapes("Maintenance Platform").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D5")) Is Nothing Then
ActiveSheet.Shapes("Boiler Control Panel").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E5")) Is Nothing Then
ActiveSheet.Shapes("Boiler Control Panel").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D6")) Is Nothing Then
ActiveSheet.Shapes("Continuous Regulation").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E6")) Is Nothing Then
ActiveSheet.Shapes("Continuous Regulation").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D7")) Is Nothing Then
ActiveSheet.Shapes("Accessories").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E7")) Is Nothing Then
ActiveSheet.Shapes("Accessories").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D8")) Is Nothing Then
ActiveSheet.Shapes("SCO Control Panel").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E8")) Is Nothing Then
ActiveSheet.Shapes("SCO Control Panel").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D9")) Is Nothing Then
ActiveSheet.Shapes("Connecting Platform").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E9")) Is Nothing Then
ActiveSheet.Shapes("Connecting Platform").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D10")) Is Nothing Then
ActiveSheet.Shapes("Stairs with Platform").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E10")) Is Nothing Then
ActiveSheet.Shapes("Stairs with Platform").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D11")) Is Nothing Then
ActiveSheet.Shapes("Boiler 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E11")) Is Nothing Then
ActiveSheet.Shapes("Boiler 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D12")) Is Nothing Then
ActiveSheet.Shapes("Eco Line 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E12")) Is Nothing Then
ActiveSheet.Shapes("Eco Line 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D13")) Is Nothing Then
ActiveSheet.Shapes("Maintenance Platform 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E13")) Is Nothing Then
ActiveSheet.Shapes("Maintenance Platform 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D14")) Is Nothing Then
ActiveSheet.Shapes("Boiler Control Panel 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E14")) Is Nothing Then
ActiveSheet.Shapes("Boiler Control Panel 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D15")) Is Nothing Then
ActiveSheet.Shapes("Continuous Regulation 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E15")) Is Nothing Then
ActiveSheet.Shapes("Continuous Regulation 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D16")) Is Nothing Then
ActiveSheet.Shapes("Accessories 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E16")) Is Nothing Then
ActiveSheet.Shapes("Accessories 2").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D17")) Is Nothing Then
ActiveSheet.Shapes("Trailer 1").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E17")) Is Nothing Then
ActiveSheet.Shapes("Trailer 1").Width = Target.Value
End If
If Not Intersect(Target, Target.Worksheet.Range("D18")) Is Nothing Then
ActiveSheet.Shapes("Trailer 2").Height = Target.Value
ElseIf Not Intersect(Target, Target.Worksheet.Range("E18")) Is Nothing Then
ActiveSheet.Shapes("Trailer 2").Width = Target.Value
End If
End Sub
Attachments
Last edited by a moderator: