VBA编程制作excel登录界面

宁子工作室利用VBA编程实现excel登录界面的设计，让你的excel看起来高大上，具体操作流程如下：

1、界面包括用户名、密码，可以修改用户名和密码

2、在修改用户名和密码的时候需要输入原来的用户名和密码，该用户名和密码存放在excel自带的名称管理器中，可以实现更新

3、用户名或者密码输入错误3次即提示输入错误而退出，无权打开该excel表格

4、输入了正确的用户名和密码后会看到欢迎提示框

主要代码如下：

Sub NameVisible()

  Names('username').Visible = False

  Names('userword').Visible = False

End Sub

Private Sub Workbook_Open()

Application.Visible = False

denglu.Show

MsgBox '欢迎登录宁子工作室！'

End Sub

Private Sub cmd1_Click()

 Application.ScreenUpdating = False

    Static i As Integer

    If CStr(t1.Value) = Right(Names('UserName').RefersTo, Len(Names('UserName').RefersTo) - 1) And CStr(t2.Value) = Right(Names('UserWord').RefersTo, Len(Names('UserWord').RefersTo) - 1) Then

    Unload Me

    Application.Visible = True

    Else

         i = i 1

         If i = 3 Then

            MsgBox '对不起，你无权打开工作簿！', vbInformation, '提示'

               ThisWorkbook.Close savechanges:=False

        Else

            MsgBox '输入错误，你还有' & (3 - i) & '次输入机会', vbExclamation, '提示'

            t1.Value = ''

            t2.Value = ''

         End If

    End If

 Application.ScreenUpdating = True

End Sub

Private Sub cmd2_Click()

Unload Me

ThisWorkbook.Close savechanges:=False

End Sub

Private Sub cmd3_Click()

     Dim old As String, new1 As String, new2 As String

     old = InputBox('请输入原用户名：', '提示')

      new1 = InputBox('请输入新用户名：', '提示')

       new2 = InputBox('请再次输入新用户名：', '提示')

      If old <> '' And new1 <> '' Then

       If old = Right(Names('UserName').RefersTo, Len(Names('UserName').RefersTo) - 1) And new1 = new2 Then

       Names('UserName').RefersTo = '=' & new1

       ThisWorkbook.Save

       MsgBox '用户名修改完成，下次登录请使用新用户名', vbInformation, '提示'

       Else

         MsgBox '输入错误，修改没有完成', vbCritical, '错误'

         End If

        Else

        MsgBox '用户名不能为空', vbCritical, '错误'

        End If

        

End Sub

Private Sub cmd4_Click()

Dim old As String, new1 As String, new2 As String

     old = InputBox('请输入原密码：', '提示')

      new1 = InputBox('请输入新密码：', '提示')

       new2 = InputBox('请再次输入新密码：', '提示')

      If old <> '' And new1 <> '' Then

       If old = Right(Names('UserWord').RefersTo, Len(Names('UserWord').RefersTo) - 1) And new1 = new2 Then

       Names('UserWord').RefersTo = '=' & new1

       ThisWorkbook.Save

       MsgBox '用户密码修改完成，下次登录请使用新密码', vbInformation, '提示'

       Else

         MsgBox '输入错误，修改没有完成', vbCritical, '错误'

         End If

        Else

        MsgBox '密码不能为空', vbCritical, '错误'

        End If

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

If CloseMode <> 1 Then Cancel = 1

End Sub