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

问题描述

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

当您单击按钮时,目的是将标签中的标题复制到文本框中。我已经创建了代码和按钮事件,所以我可以识别被点击的按钮,但是,当我尝试引用标签或文本框时,我得到“运行时错误‘-2147024809(80070057)’:找不到指定的对象。 "

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

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”的类,并使用以下代码在按钮上创建一个点击事件:

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 事件完成,它们就无法再访问了。我想我需要做一些其他事情才能使它们可以访问吗?我做错了什么?

这是完整的代码删除了不相关的功能和事件):

用户表单 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",True)
                    Set dynTextBox = frameInputs.Controls.Add("Forms.TextBox.1",True)
                    Set dynXferLabelButton = frameInputs.Controls.Add("Forms.CommandButton.1",True)
                Else:
                    cOut = cOut + 1
                    ctrlLeft = 20
                    ctrlTop = (20 * cOut)
                    Set dynLabel = frameOutputs.Controls.Add("Forms.Label.1",True)
                    Set dynTextBox = frameOutputs.Controls.Add("Forms.TextBox.1",True)
                    Set dynXferLabelButton = frameOutputs.Controls.Add("Forms.CommandButton.1",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

类按钮事件

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

解决方法

frmSetDevice 指的是“基本”用户表单,而不是显示的实例。

如果你在你的类中为相应的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 而无需保持计数和调整数组大小。