Ссылки на значения из процедурно сгенерированных меток из другой пользовательской формы в VBA - PullRequest
0 голосов
/ 18 января 2019

Я создаю пользовательский интерфейс, который может вставлять, удалять и отображать информацию из нескольких наборов данных. Пользователь нажимает командную кнопку для запуска программы, вводит некоторые данные, и userform1 использует эти данные для создания userform2. При использовании userform2 я хочу, чтобы пользователь мог обновлять отображаемую информацию как в пользовательской форме, так и в листе Excel на основе информации, введенной в поле txtbox, сгенерированное в пользовательской форме 2. У меня проблема в том, что, когда я пытаюсь сослаться на txtbox и метку, сгенерированную из UserForm1 для UserForm2 из Userform2, он не может их найти. Я также использовал цикл for, чтобы назвать их, так что я подумал, что это должно быть так же просто, как Rag2.caption или UserForm2! Rag2.Caption. UserForm1:

Private Sub CommandButton1_Click()

UserForm1.Show

End Sub

Private Sub CANCELBUTT_Click()

Unload Me

End Sub

Public Sub InsertBUTT_Click()
Dim check As Range
If LINBOX.Value <> "" And NOMBOX.Value <> "" Then
    Set check = Columns("A:A").Find(What:=LINBOX.Value, After:=Range("A1"), _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If check Is Nothing Then
        Dim BlankRow As Long
        BlankRow = Range("A65536").End(xlUp).Row + 1
        Cells(BlankRow, 1).Value = LINBOX.Value
        Cells(BlankRow, 2).Value = NOMBOX.Value
    End If
Else
    MsgBox "Both LIN and Nomenclature are required to insert a new LIN"
End If

Unload Me
UserForm1.Show

End Sub

Private Sub LINBOX_DropButtonClick()

Dim cl As Range

With ActiveSheet
    For Each cl In Range([A3].CurrentRegion.Columns(1).Address)
        If cl.Value <> "" Then
             With LINBOX
                .AddItem cl.Value
             End With
        End If
    Next cl

End With

End Sub
Private Sub LINBOX_Change()
Dim Rng As Range
Dim cat As Integer
    ' Create a new Combo Box for the overhead categories
    UserForm1.Controls.Add "Forms.ComboBox.1", "CATBOX", True
    UserForm1!CATBOX.Visible = False
        With UserForm1!CATBOX
            .Height = 20
            .Width = 150
            .Left = 100
            .Top = 40
        End With

    If LINBOX.Value <> "" Then

    ' Find the position of the LIN and display the corresponding Nomenclature
        Set Rng = Columns("A:A").Find(What:=LINBOX.Value, After:=Range("A1"), _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Rng Is Nothing Then
    'Do nothing
        Else
            NOMBOX = ActiveSheet.Cells(Rng.Row, Rng.Column + 1).Value

            UserForm1!CATBOX.Visible = True

    ' Fill the combo box with the Category Titles
            With ActiveSheet
                For cat = 1 To 999
                    col = ActiveSheet.Cells(1, cat).Value
                    If col <> "" Then
                        With UserForm1!CATBOX
                            .AddItem col
                        End With
                    End If
                Next cat
            End With
        End If
    End If
End Sub


Private Sub OKBUTT_Click()
Dim Rng As Range, SubRng As Range, subVal As Range, Rngr As Range
Dim Rw As Long, ColSt As Long, ColEnd As Long, i As Long, ScatNo As Long
Dim Rag As Object, Rag2 As Object, Rag3 As Object
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' Label the new userform
    If (UserForm1!LINBOX.Value = "") Then
        MsgBox "Your Query wasn't found at this time"
    ElseIf (UserForm1!NOMBOX.Value = "") Then
        MsgBox "Your Query wasn't found at this time"
    ElseIf (UserForm1!CATBOX.Value = "") Then
        MsgBox "Your Query wasn't found at this time"
    ElseIf (UserForm1!LINBOX.Value = "") And (UserForm1!NOMBOX.Value = "") And (UserForm1!CATBOX.Value = "") Then
        MsgBox "Your Query wasn't found at this time"
    Else
        Set LINB = UserForm2.Controls.Add("Forms.Label.1", "LINB", True)
        With LINB
            .Caption = LINBOX.Value
            .Left = 10
            .Width = 50
            .Top = 5
        End With

        Set NOMB = UserForm2.Controls.Add("Forms.Label.1", "NOMB", True)
        With NOMB
            .Caption = NOMBOX.Value
            .Left = 10
            .Width = 200
            .Top = 15
        End With


        Set CATB = UserForm2.Controls.Add("Forms.Label.1", "CATB", True)
        With CATB
            .Caption = UserForm1!CATBOX.Value
            .Left = 400
            .Width = 200
            .Top = 5
        End With
 ''''''''''''''''''''''''''''''Merged Columns Start & End''''''''''''''''''''''''''''''''''''''''''''''''''
        With ActiveSheet

            '' Find the Category in the first row
            Set Rng = .Rows(1).Find(What:=UserForm1!CATBOX.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            '' If the category is not found, then it won't go through the code
            If Rng Is Nothing Then Exit Sub
            '' Determine the range of the merged columns
            Set Rng = Rng.MergeArea
            Set rngStart = Rng.Cells(1, 1)
            Set rngEnd = Rng.Cells(Rng.Rows.Count, Rng.Columns.Count)
            Rw = Rng.Row + Rng.Rows.Count
            ColSt = Rng.Column
            ColEnd = Rng.Column + Rng.Columns.Count - 1
            Debug.Print Rw, ColSt, ColEnd
            '' Use the merged column range to determine the length of the parser, then print the value
            ''      to the new userform
    '''''''''''''''''''''''''''''''''''''''SUBCAT TITLE''''''''''''''''''''''''
            Set Rng = .Range(.Cells(Rw, ColSt), .Cells(Rw, ColEnd))
            ScatNo = 0
            '' Establish a row counter
            a = 0
               For Each SubRng In Rng
                    If SubRng.Value <> "" Then
                        ScatNo = ScatNo + 1
                        '' Create a label an give it the subcatagory value
                        Set Rag = UserForm2.Controls.Add("Forms.Label.1", "Scat" & ScatNo)
                        Rag.Caption = SubRng.Value & ":"
                        '' Check if ScatNo is part of the new row or not, anything >7 is, anything <7 is not
                        If a > 0 Then
                        '' Establish when to create a new row (every 7th data set)
                            If (ScatNo Mod 7) = 0 Then
                                Rag.Left = 30
                                Rag.Width = 50
                                Rag.Top = 40 + (a * 20)
                        '' Make the following ScatNos part of the same row
                            Else
                                Rag.Top = 40 + (a * 20)
                                Rag.Left = ((ScatNo + 1) - (a * 7)) * 125 - 85
                                Rag.Width = 50
                                If ((ScatNo + 1) Mod 7) = 0 Then
                                    a = a + 1
                                End If
                            End If
                        '' If ScatNo is less than 7
                        ElseIf a = 0 Then
                            Rag.Left = ScatNo * 90
                            If Rag.Left = 90 Then
                                Rag.Left = 30
                                Rag.Top = 40
                                Rag.Width = 50
                            Else
                                Rag.Left = ScatNo * 125 - 85
                                Rag.Top = 40
                                Rag.Width = 50
                                If ((ScatNo + 1) Mod 7) = 0 Then
                                    a = a + 1
                                End If
                            End If
                        End If
                    End If
               Next
    ''''''''''''''''''''''''''''''''''''''''''SUBCAT Values & TXTBOX'''''''''''''''''''''''''''''
               Set Rngr = Columns("A:A").Find(What:=LINBOX.Value, After:=Range("A1"), _
                    LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
               If (Rngr Is Nothing) Then
                   MsgBox "Your Query wasn't found at this time"
               Else
                   Set subVal = .Range(.Cells(Rngr.Row, ColSt), .Cells(Rngr.Row, ColEnd))
                   scat = 0
                   '' Establish a row counter
                   a = 0
                   For Each vale In subVal
                         scat = scat + 1
                         Set Rag2 = UserForm2.Controls.Add("Forms.Label.1", "ScatV" & ScatNo)
                         Set Rag3 = UserForm2.Controls.Add("Forms.TextBox.1", "ScatUp" & ScatNo)
                         Rag2.Caption = vale.Value
                         '' Check if ScatNo is part of the new row or not, anything >7 is anything <7 is not
                         If a > 0 Then
                         '' Establish when to create a new row (every 7th data set)
                             If (scat Mod 7) = 0 Then
                                 Rag2.BackColor = RGB(200, 200, 200)
                                 Rag2.Left = 70
                                 Rag3.Left = 90
                                 Rag2.Width = 50
                                 Rag3.Width = 50
                                 Rag2.Top = 40 + (a * 20)
                                 Rag3.Top = 40 + (a * 20)
                         '' Make the following Scats part of the same row
                             Else
                                 Rag2.BackColor = RGB(200, 200, 200)
                                 Rag2.Top = 40 + (a * 20)
                                 Rag3.Top = 40 + (a * 20)
                                 Rag2.Left = ((scat + 1) - (a * 7)) * 125 - 35
                                 Rag3.Left = ((scat + 1) - (a * 7)) * 125 - 15
                                 Rag2.Width = 50
                                 Rag3.Width = 50
                                 If ((scat + 1) Mod 7) = 0 Then
                                    a = a + 1
                                End If
                             End If
                         '' If Scat is less than 7
                         ElseIf a = 0 Then
                             Rag2.Left = scat * 125 - 25
                             Rag2.BackColor = RGB(200, 200, 200)
                             If Rag2.Left = 100 Then
                                 Rag2.Left = 70
                                 Rag3.Left = 90
                                 Rag2.Top = 40
                                 Rag3.Top = 40
                                 Rag2.Width = 50
                                 Rag3.Width = 50
                             Else
                                 Rag2.Left = scat * 125 - 35
                                 Rag3.Left = scat * 125 - 15
                                 Rag2.Top = 40
                                 Rag3.Top = 40
                                 Rag2.Width = 50
                                 Rag3.Width = 50
                                 If ((scat + 1) Mod 7) = 0 Then
                                    a = a + 1
                                End If
                             End If
                         End If
                Next
     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            UserForm2.Show
        End If
End With
End If
End Sub

UserForm2:

Private Sub CANCELBUTT_Click()

Unload Me

End Sub

Private Sub DELETEBUTT_Click()

Dim RngD As Range
Set RngD = Columns("A:A").Find(What:=UserForm1!LINBOX.Value, After:=Range("A1"), _
                LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Rows(RngD.Row).EntireRow.Delete
Unload Me

End Sub

Private Sub InsertBUTT_Click()
Dim Rng As Range, SubRng As Range, subVal As Range, Rngr As Range
Dim Rw As Long, ColSt As Long, ColEnd As Long, i As Long, ScatNo As Long
Dim Rag As Object, Rag2 As Object, Rag3 As Object
 ''''''''''''''''''''''''''''''Merged Columns Start & End''''''''''''''''''''''''''''''''''''''''''''''''''
With ActiveSheet

    '' Find the Category in the first row
    Set Rng = .Rows(1).Find(What:=UserForm1!CATBOX.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    '' If the category is not found, then it won't go through the code
    If Rng Is Nothing Then Exit Sub
    '' Determine the range of the merged columns
    Set Rng = Rng.MergeArea
    Set rngStart = Rng.Cells(1, 1)
    Set rngEnd = Rng.Cells(Rng.Rows.Count, Rng.Columns.Count)
    Rw = Rng.Row + Rng.Rows.Count
    ColSt = Rng.Column
    ColEnd = Rng.Column + Rng.Columns.Count - 1
    Debug.Print Rw, ColSt, ColEnd
    '' Use the merged column range to determine the length of the parser, then print the value
    ''      to the new userform
''''''''''''''''''''''''''''''''''''''''''SUBCAT Values & TXTBOX'''''''''''''''''''''''''''''
       Set Rngr = Columns("A:A").Find(What:=UserForm1!LINBOX.Value, After:=Range("A1"), _
            LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
       If (Rngr Is Nothing) Then
           MsgBox "Your Query wasn't found at this time"
       Else
           Set subVal = .Range(.Cells(Rngr.Row, ColSt), .Cells(Rngr.Row, ColEnd))
           scat = 0
           '' Establish a row counter
           a = 0
           For Each vale In subVal
                 scat = scat + 1
                 If UserForm2!Rag3.Value <> "" Then
                    vale.Value = UserForm2!Rag3.Value
                    UserForm2!Rag2.Caption = UserForm2!Rag3.Value
                    UserForm2!Rag3.Value = ""
                 Else
                    UserForm2!Rag2.Caption = vale.Value
                 End If
                 '' Check if ScatNo is part of the new row or not, anything >7 is anything <7 is not
                 If a > 0 Then
                 '' Establish when to create a new row (every 7th data set)
                     If (scat Mod 7) = 0 Then
                         Rag2.BackColor = RGB(200, 200, 200)
                         Rag2.Left = 70
                         Rag3.Left = 90
                         Rag2.Width = 50
                         Rag3.Width = 50
                         Rag2.Top = 40 + (a * 20)
                         Rag3.Top = 40 + (a * 20)
                 '' Make the following Scats part of the same row
                     Else
                         Rag2.BackColor = RGB(200, 200, 200)
                         Rag2.Top = 40 + (a * 20)
                         Rag3.Top = 40 + (a * 20)
                         Rag2.Left = ((scat + 1) - (a * 7)) * 125 - 35
                         Rag3.Left = ((scat + 1) - (a * 7)) * 125 - 15
                         Rag2.Width = 50
                         Rag3.Width = 50
                         If ((scat + 1) Mod 7) = 0 Then
                            a = a + 1
                        End If
                     End If
                 '' If Scat is less than 7
                 ElseIf a = 0 Then
                     Rag2.Left = scat * 125 - 25
                     Rag2.BackColor = RGB(200, 200, 200)
                     If Rag2.Left = 100 Then
                         Rag2.Left = 70
                         Rag3.Left = 90
                         Rag2.Top = 40
                         Rag3.Top = 40
                         Rag2.Width = 50
                         Rag3.Width = 50
                     Else
                         Rag2.Left = scat * 125 - 35
                         Rag3.Left = scat * 125 - 15
                         Rag2.Top = 40
                         Rag3.Top = 40
                         Rag2.Width = 50
                         Rag3.Width = 50
                         If ((scat + 1) Mod 7) = 0 Then
                            a = a + 1
                        End If
                     End If
                 End If
        Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
End With
End Sub

Очевидно, что я разочаровался в UserForm2, поскольку предоставленный мною код показывает, что я пытаюсь просто перезаписать уже существующие ярлыки и текстовые поля, но даже это не работает.

Пример данных

Приведенная выше ссылка является примером данных, с которыми я пытаюсь работать (у меня пока нет представителя для встраивания изображений, извините). Вся помощь приветствуется!

1 Ответ

0 голосов
/ 18 января 2019

То, что вы пытаетесь сделать, это создать UserForm1 одним нажатием кнопки на листе и UserForm2 одним нажатием кнопки на UF1. Затем вы хотите, чтобы UF2 обновлял UF1, а UF1 обновлял лист. Ваш код этого не делает, в том смысле, что нет ни объекта UF1, ни объекта UF2, ни фактически объекта объектной таблицы. Например,

Dim Ws As Worksheet
Dim Uf1 as UserForm1
Dim Uf2 As UserForm2

Set Ws = ActiveSheet
Set Uf1 = New UserForm1
Set Uf2 = New UserForm2        ' actually to be declared only later in the code

Теперь вы можете использовать Uf1.Show для отображения UserForm1 и Uf2.Hide для его скрытия. Имейте в виду, что Unload Uf1 удаляет форму из памяти, но это не тот случай, когда она скрыта. Вы можете показать его снова после его скрытия или вы можете выгрузить его и создать новый экземпляр в зависимости от того, что вы хотите сделать.

После создания с помощью команды «Установить новый», перед «Показать» и после его скрытия, но до «Выгрузки» вы можете получить доступ ко всем элементам управления каждого объекта пользовательской формы, например, Uf1.TextBox1.Text, для чтения или записи. Ws.Cells(1,1).Value = Uf1.TextBox1.Text передаст содержимое текстового поля в ячейку листа A1.

...