完美Excel密码登录窗（可移植）

        这是一个学习VBA程序设计的优秀案例——密码登录窗。经测试已无Bug，特色是窗体能置顶显示，密码验证通过后将自动打开另外一个经密码保护的工作簿，代码经简单修改便可移植使用。代码设计简洁，执行效率高，这是作者花了将近一个月的时间研究出来的成果，如果你能在一天内读懂里面的代码，你就能在一天内成为VBA程序设计的半个高手，不用再步作者后尘花大量时间来研究，大大提高新手的学习效率。

        如需完整窗体设计的代码，请点击这里下载，内含窗体设计样例，附有详细的代码注释，对于新手更加容易读懂代码的含义，快速提示VBA程序的设计水平。

ThisWorkbook代码：

Public DataBaseFile As String, DataBasePath As String, LoginPassWord As String, BasePassWord As String
Private Sub Workbook_Open()

Application.Visible = False

DataBaseFile = "DataBase.xlsm"
DataBasePath = ThisWorkbook.path & "\" & DataBaseFile
LoginPassWord = "123456"
BasePassWord = "12345678"

Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.fileExists(DataBasePath) Then
        UserForm1.Show
    Else
        MsgBox DataBaseFile & " 数据库文件丢失，请重新安装本程序！", vbExclamation, "错误"
End If
End Sub

窗体UserForm1代码：

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Dim hWnd As Long
Private Sub UserForm_Initialize()
    hWnd = FindWindow(vbNullString, Me.Caption)
    SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Sub
Private Sub userform_queryclose(Cancle As Integer, colsemode As Integer)
    If colsemode = 0 Then ThisWorkbook.Close
End Sub
Private Sub CommandButton1_Click()
    On Error Resume Next
    If TextBox1.Value = ThisWorkbook.LoginPassWord Then
           UserForm1.Hide
           Workbooks.Open Filename:=ThisWorkbook.DataBasePath, Password:=ThisWorkbook.BasePassWord
           If Err Then MsgBox ThisWorkbook.DataBaseFile & " 数据库打开失败，请联系程序管理员！", vbExclamation, "错误": ThisWorkbook.Close
           Workbooks(ThisWorkbook.DataBaseFile).Application.Visible = True
           ThisWorkbook.Close
        Else
           MsgBox "密码不正确，请重新输入！", vbInformation, "提示"
           TextBox1.Value = ""
           TextBox1.SetFocus
    End If
    On Error GoTo 0
End Sub
Private Sub CommandButton2_Click()
    ThisWorkbook.Close
End Sub
Private Sub CommandButton3_Click()
    If CommandButton3.Caption = "显示密码" Then
          CommandButton3.Caption = "隐藏密码"
          TextBox1.PasswordChar = ""
      Else
          CommandButton3.Caption = "显示密码"
          TextBox1.PasswordChar = "*"
    End If
    TextBox1.SetFocus
End Sub