Как создать форму входа пользователя с помощью vba

Привет всем, я новичок в VBA, я попытался создать страницу входа, которая позволяет пользователю входить в мой рабочий лист Excel с помощью некоторого онлайн-кода. У меня есть некоторый набор имени пользователя на листе, содержащий имя пользователя, пароль, попытку входа и статус входа в систему либо неудачный, либо успешный. Программа проверяет этот рабочий лист и предоставляет доступ, если имя пользователя и пароль совпадают с введенными пользователем, однако, когда я запускаю код, он отмечает различные ошибки. я хотел бы, чтобы сообщество помогло.

    Public Username As String
Public Password As String
Public i As Integer
Public j As Integer
Public u As String
Public p As String

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    If Trim(TextBox1.Text) = "" And Trim(TextBox2.Text) = "" Then
        MsgBox "Enter username and password.", vbOKOnly
        ElseIf Trim(TextBox1.Text) = "" Then
        MsgBox "Enter the username ", vbOKOnly
        ElseIf Trim(TextBox2.Text) = "" Then
        MsgBox "Enter the Password ", vbOKOnly
    Else
        Username = Trim(TextBox1.Text)
        Password = Trim(TextBox2.Text)
        i = 1
        Do While Cells(1, 1).Value <> ""
            j = 1
            u = Cells(i, j).Value
            j = j + 1
            p = Cells(i, j).Value
            If Username = u And Password = p And Cells(i, 3).Value = "fail" Then
                MsgBox "Your Account temporarily locked", vbCritical
                Exit Do
                Else
                If Username = "u" And Password = "p" Then
                Call clear
                UserForm1.Hide
                UserForm2.Label1.Caption = u
                UserForm2.Label1.ForeColor = &H8000000D
                UserForm2.Show
                Exit Do
                Else
                If Username <> u And Password = p Then
                MsgBox "Username not matched", vbCritical + vbOKCancel
                Exit Do
                Else
                If Username = u And Password <> p Then
                If Cells(i, 3).Value = "fail" Then
                    MsgBox "Your account is blocked", vbCritical + vbOKCancel
                    Exit Do
                    Else
                    If Cells(i, 4).Value < 2 Then
                    MsgBox "Invalid password", vbCritical
                    Cells(i, 4).Value = Cells(i, 4) + 1
                    Exit Do
                Else
                    Cells(i, 4).Value = Cells(i, 4) + 1
                    Cells(i, 3).Value = "fail"
                    Cells(i, 2).Interior.ColorIndex = 3
                    Exit Do
                End If
            Else
                i = i + 1
            End If
        Loop
    End If
    Application.ScreenUpdating = True
End Sub
Sub clear()
    TextBox1.Value = ""
    TextBox2.Value = ""
End Sub
Private Sub TextBox1_Enter()
    With TextBox1
        .Back Color = &H8000000E
        .Fore Color = &H80000001
        .Border Color = &H8000000D
        TextBox1.Text = ""
    End With

End Sub
Private Sub TextBox1_AfterUpdate()
    If TextBox1.Value = "" Then
        TextBox1.BorderColor = RGB(255, 102, 0)
    End If
    i = 1
    Do Until IsEmpty(Cells(i, 1).Value)
        If TextBox1.Value = Cells(i, 1).Value Then
            With TextBox1
                .Border Color = RGB(186, 214, 150)
                .Back Color = RGB(216, 241, 211)
                .Fore Color = RGB(81, 99, 51)
            End With
        End If
        i = i + 1
    Loop
End Sub
Private Sub TextBox2_Enter()
    With TextBox2
        .Back Color = &H8000000E
        .Fore Color = &H80000001
        .Border Color = &H8000000D
    End With
    TextBox2.Text = ""
End Sub
Private Sub TextBox2_AfterUpdate()
    i = 1
    Username = TextBox1.Value
    Password = TextBox2.Value
    If TextBox2.Text = "" Then
        TextBox2.BorderColor = RGB(255, 102, 0)
    End If
    Do Until IsEmpty(Cells(i, 1).Value)
        j = 1
        u = Cells(i, j).Value
        j = j + 1
        p = Cells(i, j).Value
        If Username = u And Password = p Then
            With TextBox2
                .Border Color = RGB(186, 214, 150)
                .Back Color = RGB(216, 241, 211)
                .Fore Color = RGB(81, 99, 51)
            End With
            Exit Do
            Else
            If Username = u And Password <> p Then
            TextBox2.BorderColor = RGB(255, 102, 0)
            Exit Do
        Else
            i = i + 1
        End If
    Loop
End Sub
Sub settings()
    With UserForm1
        TextBox1.ForeColor = &H8000000C
        TextBox2.ForeColor = &H8000000C
        TextBox1.BackColor = &H80000004
        TextBox2.BackColor = &H80000004
        TextBox1.Text = "Username"
        TextBox2.Text = "Password"
        TextBox1.BorderColor = RGB(0, 191, 255)
        TextBox2.BorderColor = RGB(0, 191, 255)
        CommandButton1.SetFocus
    End With
End Sub
Private Sub UserForm_Initialize()
    Call settings
End Sub
however when i run the code it flags various errors, вы должны начать с того, что расскажете нам, что это за ошибки и где вы их получаете.
Marcucciboy2 13.09.2018 16:23

{Private Sub TextBox1_Enter () With TextBox1 .Back Color = & H8000000E .Fore Color = & H80000001 .Border Color = & H8000000D TextBox1.Text = "" End With End Sub} он пометил метод или данные, не найденные в этом разделе кода,

Dharniss 13.09.2018 16:26

Есть несколько случаев, когда вы не следуете за своими операторами If закрывающим End If, и для одного из них у вас фактически есть два предложения Else, которые вы не можете сделать.

Marcucciboy2 13.09.2018 16:30

Я только что запустил отладку кода, и он раскрасил «Открытый пароль в виде строки». Член уже существует в объектном модуле, от которого этот объектный модуль является производным.

Dharniss 13.09.2018 16:42

В строке, упомянутой выше для TextBox1, есть пробелы между Fore и Color, что неуместно. То же самое касается следующих двух строк.

Darrell H 13.09.2018 16:45

@DarrellH вы назвали форму Password? Если да, переименуйте его, например, PasswordPrompt или что-то еще; избегайте повторного использования имен в одной и той же области :)

Mathieu Guindon 13.09.2018 17:07
эта статья Я писал недавно, в качестве примера я использовал форму входа пользователя; может вы захотите взглянуть =)
Mathieu Guindon 13.09.2018 17:12

Спасибо за помощь. однако код отмечает ошибку компиляции цикла без команды. становится все более запутанным

Dharniss 13.09.2018 17:21

«Петля без дела» возникает из-за того, что у вас есть блоки IF без End If, что, скорее всего, связано с неправильным пониманием ElseIf, который не является синонимом Else <newline> If.

JNevill 13.09.2018 17:32
Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
1
9
164
1

Ответы 1

Вот быстрое переписывание, которое абсолютно не гарантирует работы (здесь могут быть другие проблемы, не только синтаксис), но исправляет проблемы синтаксиса, из-за которых он не компилируется и его трудно отлаживать:

1) Блоки If должны содержать End If. В вашем коде переключено все, что выглядит так:

Else
    If <some condition> Then

к:

ElseIf <some Condition> Then

2) Некоторые из имен ваших свойств содержат пробелы, такие как .Back Color и т.п. Те были исправлены:

Public Username As String
Public Password As String
Public i As Integer
Public j As Integer
Public u As String
Public p As String

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
    If Trim(TextBox1.Text) = "" And Trim(TextBox2.Text) = "" Then
        MsgBox "Enter username and password.", vbOKOnly     
    ElseIf Trim(TextBox1.Text) = "" Then
        MsgBox "Enter the username ", vbOKOnly
    ElseIf Trim(TextBox2.Text) = "" Then
        MsgBox "Enter the Password ", vbOKOnly
    Else
        Username = Trim(TextBox1.Text)
        Password = Trim(TextBox2.Text)
        i = 1
        Do While Cells(1, 1).Value <> ""
            j = 1
            u = Cells(i, j).Value
            j = j + 1
            p = Cells(i, j).Value
            If Username = u And Password = p And Cells(i, 3).Value = "fail" Then
                MsgBox "Your Account temporarily locked", vbCritical
                Exit Do
            'Changed to ElseIf  
            'I don't think you want the double quotes here. 
             'I'm betting you want the variable `u` and variable `p` 
             'but with the double quotes you are literally checking if `Username` is equal to the letter "u"
            ElseIf Username = "u" And Password = "p" Then
                    Call clear
                    UserForm1.Hide
                    UserForm2.Label1.Caption = u
                    UserForm2.Label1.ForeColor = &H8000000D
                    UserForm2.Show
                    Exit Do
            'Changed to ElseIf
            ElseIf Username <> u And Password = p Then
                    MsgBox "Username not matched", vbCritical + vbOKCancel
                    Exit Do
            'Changed to ElseIf
            ElseIf Username = u And Password <> p Then
                    If Cells(i, 3).Value = "fail" Then
                        MsgBox "Your account is blocked", vbCritical + vbOKCancel
                        Exit Do
                    'Changed to ElseIf
                    ElseIf Cells(i, 4).Value < 2 Then
                        MsgBox "Invalid password", vbCritical
                        Cells(i, 4).Value = Cells(i, 4) + 1
                        Exit Do
                    Else
                        Cells(i, 4).Value = Cells(i, 4) + 1
                        Cells(i, 3).Value = "fail"
                        Cells(i, 2).Interior.ColorIndex = 3
                        Exit Do
                    End If
            Else
                i = i + 1
            End If
        Loop
    End If
    Application.ScreenUpdating = True
End Sub


Sub clear()
    TextBox1.Value = ""
    TextBox2.Value = ""
End Sub

Private Sub TextBox1_Enter()
    With TextBox1
        .Back Color = &H8000000E
        .Fore Color = &H80000001
        .Border Color = &H8000000D
        TextBox1.Text = ""
    End With

End Sub

Private Sub TextBox1_AfterUpdate()
    If TextBox1.Value = "" Then
        TextBox1.BorderColor = RGB(255, 102, 0)
    End If
    i = 1
    Do Until IsEmpty(Cells(i, 1).Value)
        If TextBox1.Value = Cells(i, 1).Value Then
            With TextBox1
                'Corrected strange space between Back and Color and so on
                .BorderColor = RGB(186, 214, 150)
                .BackColor = RGB(216, 241, 211)
                .ForeColor = RGB(81, 99, 51)
            End With
        End If
        i = i + 1
    Loop
End Sub

Private Sub TextBox2_Enter()
    With TextBox2
        'Corrected strange space between Back and Color and so on
        .BackColor = &H8000000E
        .ForeColor = &H80000001
        .BorderColor = &H8000000D
    End With
    TextBox2.Text = ""
End Sub

Private Sub TextBox2_AfterUpdate()
    i = 1
    Username = TextBox1.Value
    Password = TextBox2.Value
    If TextBox2.Text = "" Then
        TextBox2.BorderColor = RGB(255, 102, 0)
    End If
    Do Until IsEmpty(Cells(i, 1).Value)
        j = 1
        u = Cells(i, j).Value
        j = j + 1
        p = Cells(i, j).Value
        If Username = u And Password = p Then
            With TextBox2
                'Corrected strange space between Back and Color and so on
                .BorderColor = RGB(186, 214, 150)
                .BackColor = RGB(216, 241, 211)
                .ForeColor = RGB(81, 99, 51)
            End With
            Exit Do
        'Changed to ElseIf
        ElseIf Username = u And Password <> p Then
            TextBox2.BorderColor = RGB(255, 102, 0)
            Exit Do
        Else
            i = i + 1
        End If
    Loop
End Sub

Sub settings()
    With UserForm1
        TextBox1.ForeColor = &H8000000C
        TextBox2.ForeColor = &H8000000C
        TextBox1.BackColor = &H80000004
        TextBox2.BackColor = &H80000004
        TextBox1.Text = "Username"
        TextBox2.Text = "Password"
        TextBox1.BorderColor = RGB(0, 191, 255)
        TextBox2.BorderColor = RGB(0, 191, 255)
        CommandButton1.SetFocus
    End With
End Sub

Private Sub UserForm_Initialize()
    Call settings
End Sub

Другие вопросы по теме