Создание и управление коллекциями элементов управления по требованию

Question

Это мой первый пост. Я пытался найти похожую тему, но не смог найти.

Я довольно новичок в VBA, и я учусь, пытаясь создать файл, который помогает планировать вырезание частей основного куска.

Поскольку Excel VBA не позволяет рисовать фигуры или линии, я использую метки с рамками для создания прямоугольников.

Прямоугольники представляют собой разрезы, которые должны быть сделаны.

Моя основная форма выглядит так:

Основная форма

Как вы можете видеть на изображении, в области, обозначенной красным прямоугольником, большой кусок с 1600 мм (в этом примере) будет иметь семь срезов по 60 мм.

Моя проблема началась, когда я попытался добавить различные разрезы в мое планирование резки. Когда я принимаю разрез, он отправляется в очередь на резку, и можно определить новый разрез, как показано на рисунке ниже:

Второй срез

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

Код на данный момент слишком обширен, чтобы добавить его сюда, но мне удалось добавить некоторые функции, которые будут описаны ниже. Некоторые имена на португальском, но я не думаю, что это представляет проблему.

Здесь я создаю срезы, определяемые Largura: и Cortes reais:

Option Explicit
Public iCuts As Integer
Public Labels As Collection
Public newLabel As Object
Public bRecalculate As Boolean


Sub DrawCuts(NCuts As Integer, CutWidth As Double, TotalWidth)
Dim OriginX, OriginY As Integer
Dim labelCounter As Long
Dim labelCollection As New Collection


OriginX = 372
OriginY = 24
CutWidth = Multiplier(CutWidth, TotalWidth)

    For labelCounter = 0 To NCuts - 1
        Set newLabel = frmPlanning.Controls.Add("Forms.Label.1", "Corte" &     labelCounter, True)
        With newLabel
            .ControlTipText = .Name 'labelCounter + 1
            .Left = OriginX + CutWidth * labelCounter
            .Width = CutWidth
            .Height = 48
            .Top = OriginY
            .BackColor = &HFFFFFF
            .BorderStyle = 1
            .TextAlign = 2
            .Font.Size = 6
            .Caption = iCuts
        End With
        iCuts = iCuts + 1
    Next
    iCuts = iCuts - 1
End Sub

И в следующем СУБЕКЕ я адаптирую разрезы к размеру основной части, определенной Larg. Bobine:

Sub Dim_Labels(Cuts As Integer, CutWidth As Double, RollWidth As Double,     RollLeft As Double)

    With frmPlanning.lCutWidth
        .Caption = CutWidth * Cuts
        .Width = Cuts * Multiplier(CutWidth, RollWidth)
    End With

    With frmPlanning.lCutLeft
        .Caption = RollLeft
        .Left = 372 + Cuts * Multiplier(CutWidth, RollWidth) 
        .Width = 320 - Cuts * Multiplier(CutWidth, RollWidth) 
    End With

    frmPlanning.lRollWidth = RollWidth
End Sub

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

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

Я не смог найти способ, но могу предоставить файл excel, чтобы помочь вам лучше понять проблему, если есть способ.

Спасибо. Жулио

Answer 1

Итак, я думаю, это то, что вы ищете. Обратите внимание, что это не самый чистый код, но он делает биты рисования в пользовательской форме изолированно.

Во-первых, я сохранил OriginX и OriginY в самой пользовательской форме - в конце концов, он должен контролировать, где должен начинаться рисунок. Код формы пользователя:

Public OriginX As Integer
Public OriginY As Integer
Private Sub UserForm_Initialize()
    OriginX = 20
    OriginY = 20
End Sub

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

Класс BigBox:

Private p_width As Integer
Private p_height As Integer
Private p_label As MSForms.Label
Public Property Let Width(value As Integer)
    p_width = value
    p_label.Width = p_width
End Property
Public Property Get Width() As Integer
    Width = p_width
End Property
Public Property Let Height(value As Integer)
    p_height = value
    p_label.Height = p_height
End Property
Public Property Get Height() As Integer
    Height = p_height
End Property
Public Property Get Label() As MSForms.Label
    Set Label = p_label
End Property
Private Sub Class_Initialize() 'This bit is bad practice, but it works:
    Set p_label = frmPlanning.Controls.Add("Forms.Label.1", "BigBox", True)
    p_label.Left = frmPlanning.OriginX
    p_label.Top = frmPlanning.OriginY
    p_label.BorderColor = Red
    p_label.BorderStyle = 1
End Sub

Затем я создал класс «Cut», который можно использовать в коллекции с разрезами, поэтому, когда вам нужно перерисовать, вы сохраняете их / они не забываются:

Класс резки:

Private p_width As Integer
Private p_height As Integer
Public Property Let Width(value As Integer)
    p_width = value
End Property
Public Property Get Width() As Integer
    Width = p_width
End Property
Public Property Let Height(value As Integer)
    p_height = value
End Property
Public Property Get Height() As Integer
    Height = p_height
End Property

Далее я выделил коллекции «Вырезы» и «Метки», поскольку при добавлении второго пакета метки необходимо удалять и перерисовывать. Следующая процедура

• Убедитесь, что коллекция Cuts и коллекции этикеток существуют
• Показывает форму (без режима, поэтому выполнение кода продолжается)
• Создает BigBox и устанавливает высоту и ширину. Все сокращения будут принимать высоту отсюда.
• Добавляет порезы пару раз.
• Имеет ли подпрограмма add cut также выполнение процедуры рисования.

Код модуля 1:

Option Explicit
Public bb As BigBox
Public cuts As Collection
Public cutLabels As Collection
Public totalCutsWidth As Integer
Public piece As Cut
Sub test2()
    If cuts Is Nothing Then
        Set cuts = New Collection
    End If
    If cutLabels Is Nothing Then
        Set cutLabels = New Collection
    End If

    frmPlanning.Show vbModeless

    Set bb = New BigBox
    bb.Height = 100
    bb.Width = 500
    AddCuts 5, 20
    AddCuts 10, 10
    AddCuts 7, 50
End Sub

Sub AddCuts(numberOfCuts As Integer, widthOfCuts As Integer)
Dim i As Integer
If numberOfCuts <= 0 Then Exit Sub
For i = 1 To numberOfCuts
    Set piece = New Cut
    piece.Width = widthOfCuts
    piece.Height = bb.Height
    totalCutsWidth = totalCutsWidth + widthOfCuts
    If totalCutsWidth <= bb.Width Then
        cuts.Add piece
    End If
Next i
DrawCuts
End Sub
Sub DrawCuts()
Dim i As Integer
Dim OffsetX As Integer
Dim newLabel As MSForms.Label

OffsetX = 0

For i = cutLabels.Count To 1 Step -1
    frmPlanning.Controls.Remove "Corte" & i
    cutLabels.Remove i
Next i

i = 0
OffsetX = frmPlanning.OriginX
For Each piece In cuts
    i = i + 1
    Set newLabel = frmPlanning.Controls.Add("Forms.Label.1", "Corte" & i, True)
    With newLabel
        .ControlTipText = .Name
        .Left = OffsetX
        .Width = piece.Width
        .Height = piece.Height
        .Top = frmPlanning.OriginY
        .BackColor = &HFFFFFF
        .BorderStyle = 1
        .TextAlign = 2
        .Font.Size = 6
        .Caption = i
        OffsetX = OffsetX + piece.Width
    End With
    cutLabels.Add newLabel
Next piece
End Sub

Обратите внимание, что добавление вырезов гарантирует, что вырезы по-прежнему помещаются в большую коробку, и что чертеж разрезов отделен от этого. Кроме того, если следующий кусок больше не помещается в коробку, он не будет добавлен. То есть если большая коробка имеет ширину 500, и вы добавляете 10 срезов шириной 25, а затем 11 срезов шириной 30, он добавит только первые 8 из второй партии (10 * 25 = 250, 8 * 30 = 240, 240 + 250 = 490, поэтому 9-е, 10-е и 11-е места не укладываются в общую ширину 500, поэтому добавляться не будут.

Надеюсь, что это поможет и достаточно информации, чтобы объединиться с существующим решением.