尝试访问在 VBA 中运行时创建的控件的属性时出现运行时错误 (Visio)

Question

在 Visio 中，我有一个用户窗体，其中填充了一些基于 Visio 符号的标签、按钮和文本框。标签、按钮和文本框是在运行时创建的。 Here is a snip of the form created

当您单击按钮时，目的是将标题从标签复制到文本框中。我已经创建了代码和按钮事件，因此我可以识别被单击的按钮，但是，当我尝试引用标签或文本框时，我得到“Run-time 错误‘-2147024809 (80070057)’：找不到指定的object.

这是我在运行时间创建控件的部分代码：

Set dynLabel = frameInputs.Controls.Add("Forms.Label.1", "dynLabel" & CStr(s.Index), True)
Set dynTextBox = frameInputs.Controls.Add("Forms.TextBox.1", "dynTextBox" & CStr(s.Index), True)
Set dynXferLabelButton = frameInputs.Controls.Add("Forms.CommandButton.1", "dynXferLabelButton" & CStr(s.Index), True)

我使用一些不同的 WITH 语句来设置每个控件的位置等。我还将 s.Index 值分配给 TAG 属性，这样我就可以确定稍后单击的是哪个按钮。

With dynLabel
   .Top = ctrlTop
   .Left = ctrlLeft
   .Caption = ctrlText
   .Tag = s.Index
End With
With dynTextBox
   .Top = ctrlTop
   .Left = ctrlLeft + 80
   .Text = ctrlText
   .Tag = s.Index
End With                  
With dynXferLabelButton
   .Top = ctrlTop
   .Left = ctrlLeft + 60
   .Caption = ">>"
   .Width = 20
   .Height = 17
   .FONTSIZE = 6
   .Tag = s.Index
End With

我有一个名为“ButtonEvents”的 class 并使用以下代码在按钮上创建点击事件：

Dim cmdArray() As New ButtonEvents
...
...
ReDim Preserve cmdArray(i)
Set cmdArray(i).cmdEvents = dynXferLabelButton

作为一个简单的测试，这是我的按钮点击事件。当您单击按钮时，事件会触发，我可以从按钮中获取 TAG - 一切正常。使用 TAG，然后我可以确定 Label 控件的名称，我想我可以访问 Label 的属性：

Private Sub cmdEvents_Click()
    MsgBox cmdEvents.Tag
    MsgBox frmSetDevice.frameInputs.Controls.Item("dynLabel" & cmdEvents.Tag).Caption
    Dim c As Control
    For Each c In frmSetDevice.frameInputs.Controls
            MsgBox c.Name
    Next     
End Sub

当我尝试使用 frmSetDevice.frameInputs.Controls.Item("dynLabel" & cmdEvents.Tag).Caption 或任何其他属性时出现运行时错误。如果我注释掉该行并让它运行通过循环向我展示控件，它找不到任何东西。

如果我在 UserForm_Activate 函数中的控件都创建完成后循环，它可以完美地找到所有控件。在我看来，一旦创建了控件并且 UserForm_Activate 事件结束，它们就无法再访问了。我想我需要做其他事情才能使它们易于访问吗？我做错了什么？

这是完整代码（删除了 un-related 函数和事件）：

用户窗体 frmSetDevice

Dim cmdArray() As New ButtonEvents

Private Sub UserForm_Activate()
    'MsgBox "Activate: " & DeviceCodeValue
    Dim cIn, cOut As Integer
    Dim ctrlLeft, ctrlTop As Integer
    Dim ctrlText As String
    
    If DeviceCodeValue <> 0 Then textCode.Text = DeviceCodeValue
    If DeviceDescriptionValue <> 0 Then comboDevices = DeviceDescriptionValue
    
    Set dataCollection = Nothing
    FindShapeData ActivePage.Shapes(Me.DeviceObject), "Label"
    Erase Labels
    Labels = toArray(dataCollection)
    Dim s As Visio.Shape
    For i = 0 To UBound(Labels)
        For Each s In ActivePage.Shapes(DeviceObjectName).Shapes
            If s.Name = Labels(i) Then
                'MsgBox GetShapeData(s, "Category")
                Dim dynLabel As Control
                Dim dynTextBox As Control
                Dim dynXferLabelButton As Control
                If InStr(Labels(i), "In") > 0 Then
                    cIn = cIn + 1
                    ctrlLeft = 20
                    ctrlTop = (20 * cIn)
                    Set dynLabel = frameInputs.Controls.Add("Forms.Label.1", "dynLabel" & CStr(s.Index), True)
                    Set dynTextBox = frameInputs.Controls.Add("Forms.TextBox.1", "dynTextBox" & CStr(s.Index), True)
                    Set dynXferLabelButton = frameInputs.Controls.Add("Forms.CommandButton.1", "dynXferLabelButton" & CStr(s.Index), True)
                Else:
                    cOut = cOut + 1
                    ctrlLeft = 20
                    ctrlTop = (20 * cOut)
                    Set dynLabel = frameOutputs.Controls.Add("Forms.Label.1", "dynLabel" & CStr(s.Index), True)
                    Set dynTextBox = frameOutputs.Controls.Add("Forms.TextBox.1", "dynTextBox" & CStr(s.Index), True)
                    Set dynXferLabelButton = frameOutputs.Controls.Add("Forms.CommandButton.1", "dynXferLabelButton" & CStr(s.Index), True)
                End If
                    
                ctrlText = s.Text
                If LabelDataValue(s.Index) <> "" Then ctrlText = LabelDataValue(s.Index)
                With dynLabel
                    .Top = ctrlTop
                    .Left = ctrlLeft
                    .Caption = ctrlText
                    .Tag = s.Index
                End With
    
                If GetShapeData(s, "Label") = 0 Then
                    ctrlText = s.Text
                Else:
                    ctrlText = GetShapeData(s, "Label")
                End If
                With dynTextBox
                    .Top = ctrlTop
                    .Left = ctrlLeft + 80
                    .Text = ctrlText
                    .Tag = s.Index
                End With
                    
                With dynXferLabelButton
                    .Top = ctrlTop
                    .Left = ctrlLeft + 60
                    .Caption = ">>"
                    .Width = 20
                    .Height = 17
                    .FONTSIZE = 6
                    .Tag = s.Index
                End With
                ReDim Preserve cmdArray(i)
                Set cmdArray(i).cmdEvents = dynXferLabelButton
                    
                Exit For
            End If
        Next
    Next i
    Dim totalLines As Integer
    If cIn >= cOut Then
        totalLines = cIn
    Else:
        totalLines = cOut
    End If
    
    Me.Height = (25 * totalLines) + 150
    frameInputs.Height = (25 * totalLines)
    frameOutputs.Height = (25 * totalLines)
    If Me.Height < 330 Then Me.Height = 330
    cmdCancel.Top = Me.Height - 60
    cmdSetDevice.Top = Me.Height - 60




    Dim c As Control
    For Each c In Me.frameInputs.Controls
            MsgBox c.Name
    Next
    
End Sub

Class 按钮事件

Public WithEvents cmdEvents As MSForms.CommandButton

Private Sub cmdEvents_Click()
    MsgBox cmdEvents.Tag
    MsgBox frmSetDevice.frameInputs.Controls.Item("dynLabel" & cmdEvents.Tag).Caption
    Dim c As Control
    For Each c In frmSetDevice.frameInputs.Controls
            MsgBox c.Name
    Next     
End Sub

Answer 1

frmSetDevice 指的是“基本”用户窗体，而不是显示的实例。

如果您在 class 中为相应的 Label 和 Textbox 对象添加字段，那么您可以在 Click 事件中使用它们，而不必按名称查找它们

Public WithEvents cmdEvents As MSForms.CommandButton
Public lbl As MSForms.Label   'populate these when you populate cmdEvents
Public txt As MSForms.Textbox

Private Sub cmdEvents_Click()
    
    MsgBox lbl.Caption 'etc etc
      
End Sub

我喜欢使用全局集合来保存这些类型的事件处理对象：您可以 .Add 而无需保持计数和调整数组大小。

尝试访问在 VBA 中运行时创建的控件的属性时出现运行时错误 (Visio)

Runtime error when trying to access properties of a control created at runtime in VBA (Visio)

vba

controls

runtime

visio