excel - 在用户表单上生成一个可以拖放的新标签

Question

我使用以下代码使用户能够拖放标签。

代码工作正常 - 但我正在寻找一种方法1)在处理多个标签时简化代码2)为用户提供创建具有相同属性(即拖放)的新标签的选项。

就目前情况而言，代码专门引用特定标签，即 Label1 等，我必须一次又一次复制代码才能引用我想要的所有标签(50+)

那么本质上有没有一种方法可以让我的代码自动适用于所有标签，无论是现有的标签还是新创建的标签？

Private x_offset%, y_offset%
Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As    Integer, _
ByVal X As Single, ByVal Y As Single)

If Button = XlMouseButton.xlPrimaryButton Then
 x_offset = X
 y_offset = Y 
End If

End Sub

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)

If Button = XlMouseButton.xlPrimaryButton Then
Label1.Left = Label1.Left + X - x_offset
Label1.Top = Label1.Top + Y - y_offset
End If

End Sub

谢谢

Answer 1

回复有点晚了，但这是如何完成的。这个想法是，您需要创建一个可以处理 Label 事件的类模块。一旦您有了处理事件的类，您就需要连接新的/现有的标签来遍历该类。这通常是通过创建一个包含所有类对象的 Collection 来完成的。除此之外，您只需为每个标签(新的或现有的)创建一个类对象。需要以下部分:

• UserForm1 及其背后的代码
• LabelHolder 类模块

LabelHolder 类模块包含理想“标签持有者”的代码。这是一个简单的类，它保存对 MSForms.Label 的引用并处理每个事件。请注意，我已调用对象 Label1 以便我可以延迟复制您的代码。此Label1与UserForm上的Label1无关；它们具有不同的范围并且是独立的。

'class module code
Public WithEvents Label1 As MSForms.Label
Private x_offset%, y_offset%

Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single)

    If Button = XlMouseButton.xlPrimaryButton Then
        x_offset = X
        y_offset = Y
    End If

End Sub

Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
    ByVal X As Single, ByVal Y As Single)

    If Button = XlMouseButton.xlPrimaryButton Then
        Label1.Left = Label1.Left + X - x_offset
        Label1.Top = Label1.Top + Y - y_offset
    End If

End Sub

UserForm1 代码隐藏 显示按钮的事件，该按钮创建新的 Label 并将其添加到 Collection 中。它还存储Collection，确保类对象具有全局范围并且不会被过早垃圾回收。还有一个 Initialize 事件，它展示了如何将现有的 Label 添加到折叠中。

'UserForm1 code behind
Dim labels As Collection

Private Sub CommandButton1_Click()

    If labels Is Nothing Then
        Set labels = New Collection
    End If

    Dim lbl As MSForms.Label
    Set lbl = Frame1.Controls.Add("Forms.Label.1")

    lbl.Caption = "testing"

    Dim holder As New LabelHolder
    Set holder.Label1 = lbl

    labels.Add holder

End Sub

Private Sub UserForm_Initialize()

    If labels Is Nothing Then
        Set labels = New Collection
    End If

    Dim holder As New LabelHolder
    Set holder.Label1 = Label1

    labels.Add holder

End Sub

最后这是一个 UserForm1 的图像，它具有所有控件的默认名称。

单击按钮并拖动内容后的相同形式:

所有这些代码都展示了如何将类模块连接到用户表单上动态创建的原始组件。它没有解决如何通过拖放创建新的标签，但这是可能的。您可以将该代码放入类模块中，并确保有足够的引用返回用户表单，以便访问那里所需的属性。