创建和操作运行时控件的按需集合

时间:2018-09-04 14:16:36

标签: excel vba excel-vba collections

这是我的第一篇文章。我试图找到类似的主题,但找不到任何主题。

我对VBA还是很陌生,我正在学习创建一个有助于计划主要零件的切割文件的学习。

由于Excel VBA不允许绘制形状或线条,因此我使用带有边框的标签来创建矩形。

矩形代表要进行的切割。

我的主要形式如下:

Main Form

您可以在图像中看到,在用红色矩形表示的区域中,具有1600 mm的大块(在此示例中)将有七个60 mm的切口。

当我尝试在切割计划中添加其他切割时,我的问题就开始了。 当我接受剪切后,它将进入剪切队列,可以定义一个新剪切,如下图所示:

Second cut

问题在于第一次切割应该留在那里。我意识到必须为此使用 Collections Classes 。 这一点尤其重要,因为我希望在队列中能够上下移动队列中的每一行,甚至擦除一行(并在我的“绘图”中反映出来)。

现在的代码过于广泛,无法在此处添加,但是我设法在其中添加了一些功能。有些名称是葡萄牙语,但我认为这没有问题。

我在这里创建由 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

然后在下一个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文件来帮助您更好地理解问题。

谢谢。 朱利奥

1 个答案:

答案 0 :(得分: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

接下来,我创建了一个“剪切”类,该类可以在带有剪切的集合中使用,因此当您需要重绘时,可以将它们存储起来/它们不会被遗忘:

剪切类:

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并设置高度和宽度。所有削减都将从这里开始。
  • 添加削减了几次。
  • 具有“添加剪切”例程的用户还可以执行绘图例程。

Module1代码:

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,因此不会添加。

希望这会有所帮助,并且有足够的信息可以合并到您现有的解决方案中。