Изменение количества формы на основе значения ячейки

Question

У меня есть макрос, который создает масштабированную форму на основе введенных пользователем размеров на листе «Ввод информации».Макрос связан с кнопкой, и после нажатия кнопки форма появляется на выбранном пользователем листе (ws - ws5), а размеры, количество и описание формы добавляются на лист «Спецификация судна».Пользователь может также вводить количество фигур в ячейку на листе «Ввод информации», но до сих пор я не смог связать количество форм для создания более чем одной формы.

Прямо сейчас у меня есть другая кнопка (по сути, тот же макрос, но без добавления деталей формы на лист "спецификации судна"), который пользователь может использовать для создания дополнительных фигур, если выбранное количество больше единицы.Я пытаюсь устранить эту дополнительную работу.

Sub AddShapeToCell()

Dim s As Shape
Dim r As Long
Dim ws As Worksheet
Set ws = Sheets("Deep Blue")
Set ws1 = Sheets("GC II")
Set ws2 = Sheets("300ft Barge")
Set ws3 = Sheets("275ft Barge")
Set ws4 = Sheets("250ft Barge")
Set ws5 = Sheets("User Defined Vessel")
Dim TriggerCellb As Range
Set TriggerCellb = Range("D8")
Const scaling As Double = 2.142857


'Create a shape

If TriggerCellb.Value = "Deep Blue" Then
Set s = ws.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

ElseIf TriggerCellb.Value = "GC II" Then
Set s = ws1.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

ElseIf TriggerCellb.Value = "300ft Barge" Then
Set s = ws2.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

ElseIf TriggerCellb.Value = "275ft Barge" Then
Set s = ws3.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

ElseIf TriggerCellb.Value = "250ft Barge" Then
Set s = ws4.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

ElseIf TriggerCellb.Value = "User Defined Vessel" Then
Set s = ws5.Shapes.AddShape(Cells(4, 17), 53, 66, Cells(20, 4) * scaling * 
Cells(5, 17), Cells(22, 4) * scaling * Cells(5, 17))

End If
'make it nearly white
s.Fill.ForeColor.RGB = RGB(245, 245, 255)

'show text within it
s.TextFrame.Characters.Text = Range("d12").Value
s.TextFrame.Characters.Font.ColorIndex = 2

With s.TextFrame.Characters(0, 0)
s.TextFrame.HorizontalAlignment = xlHAlignCenter
s.TextFrame.VerticalAlignment = xlVAlignCenter
.Font.Color = RGB(0, 0, 0)

End With

'add to BOM
Dim lastCell As Range
Set lastCell = Sheets("Vessel BOM").Range("C" & 
Rows.Count).End(xlUp).Offset(1, 0)

Sheets("Enter Information").Range("g20:m20").Copy
lastCell.PasteSpecial (xlPasteValues)

Sheets("Enter Information").Range("g20:m20").Copy
lastCell.PasteSpecial (xlPasteFormats)
Application.CutCopyMode = False

End Sub

Answer 1

Не совсем точно, что вы спрашиваете, но вы можете создать несколько фигур, например, так:

Sub x()

Dim s As Shape, i As Long

For i = 1 To range("A1").value
    Set s = ActiveSheet.Shapes.AddShape(msoShapeBevel, 10, 20 * i, 10, 10)
Next i

End Sub