Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
4.1k views
in Technique[技术] by (71.8m points)

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

In Visio, I have a UserForm that is populated with some labels, buttons and textboxes based on a Visio Symbol. The labels, buttons and textboxes are created at runtime. Here is a snip of the form created

When you click the button, the intention is to copy the caption from the label into the textbox. I have created the code and button event so I can identify the button being clicked, however, when I try to reference the label or textbox I get "Run-time error '-2147024809 (80070057)': Could not find the specified object."

Here is part of my code that creates the controls at runtime:

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)

I use some various WITH statements to set the position, etc, of each control. I also assign the s.Index value to the TAG property so I can identify which Button is being clicked later.

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

I have a class called "ButtonEvents" and use the following code to create a click event on the button:

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

As a simple test, here is my click event for the button. When you click the button, the event triggers and I can get the TAG from the button - this is all working fine. Using the TAG, I can then determine the name of the Label control, and I presume I can then access the properties of the 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

I get the Runtime error when I try to use frmSetDevice.frameInputs.Controls.Item("dynLabel" & cmdEvents.Tag).Caption or any other property. If I comment out that line and let it run through the loop to show me the controls, it doesn't find anything.

If I loop through the controls within the UserForm_Activate function just after they are all created, it can find all the controls perfectly fine. It seems to me that once the controls are created and the UserForm_Activate event has finished, they are no longer accessible. I presume I need to do something else to make them accessible? What am I doing wrong?

Here is the full code (with un-related functions and events removed):

UserForm 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 ButtonEvents

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Reply

0 votes
by (71.8m points)

frmSetDevice refers to the "base" userform, not the instance which is displayed.

If you add fields in your class for the corresponding Label and Textbox objects, then you can use them in the Click event without having to find them by name

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

I like using a global Collection to hold these types of event-handling objects: you can just .Add without needing to keep count and resize an array.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
OGeek|极客中国-欢迎来到极客的世界,一个免费开放的程序员编程交流平台!开放,进步,分享!让技术改变生活,让极客改变未来! Welcome to OGeek Q&A Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...