Chào các anh chị trên diển đàn!
Mình có một file tên NHA TRO lúc mình viết code để đăng nhập file do mình quên sao lưu ra một file dự trữ. Nên khi viết xong chạy thử thì không vào được file nữa, mong anh chị hướng dẫn xem phần code bị sai chổ nào mà không vào được file.
Đây là phần code của mình cho form đăng nhập, trong đó sheet Nguon ở cột H2=TIẾN MINH, H3=111111, H4=MINH TÂN, H5=170391. Sheet này dùng để lưu User name và password để đăng nhập.
Mong anh chị giúp đở xem có cách nào để mở được file và xem phần code mình viết nó sai chổ nào. rất cám ơn các anh chị
Option Explicit
'*********************************************************************************************
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private isFocus As Boolean, isClose As Byte, Usr As Variant, Pwd As Variant, Usr1 As Variant, Pwd1 As Variant
'*********************************************************************************************
Private Sub UserForm_Initialize()
Workbooks(ThisWorkbook.Name).Activate
Application.EnableCancelKey = xlErrorHandler
Application.Visible = False
Dim hWnd As Long
On Error Resume Next
hWnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowLong hWnd, -16, &H84080080
Me.Height = 130
Usr = Nguon.[H2].Value
Pwd = Nguon.[H3].Value
Usr1 = Nguon.[H4].Value
Pwd1 = Nguon.[H5].Value
txtUser = Usr
With txtPassword
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
End Sub
Private Sub UserForm_Terminate()
Application.EnableCancelKey = xlInterrupt
End Sub
'*********************************************************************************************
Private Sub txtUser_Enter()
isFocus = True
End Sub
Private Sub txtUser_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
With txtUser
If isFocus Then .SelStart = 0: .SelLength = Len(.Text)
End With
isFocus = False
End Sub
'*********************************************************************************************
Private Sub txtPassword_Enter()
isFocus = True
End Sub
Private Sub txtPassword_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
With txtPassword
If isFocus Then .SelStart = 0: .SelLength = Len(.Text)
End With
isFocus = False
End Sub
'*********************************************************************************************
Private Sub CmdNhap_Click()
isClose = isClose + 1
If isClose = 4 And (txtUser <> Usr Or txtUser <> Usr1 Or txtPassword.Text <> Pwd Or txtPassword.Text <> Pwd1) Then
MsgBox "Rat tiec, ban da nhap 4 lan khong dung User Name hoac Password, " _
& "chuong trinh se tu dong thoat.", vbCritical, "THÔNG BÁO"
CmdThoat_Click
Exit Sub
End If
If txtUser <> Usr Or txtUser <> Usr1 Then
MsgBox "Ban chua nhap dung User Name", vbInformation, "THÔNG BÁO"
With txtUser
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
ElseIf txtPassword.Text <> Pwd Or txtPassword.Text <> Pwd1 Then
isFocus = False
MsgBox "Ban chua nhap dung Password", vbInformation, "THÔNG BÁO"
With txtPassword
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Else
Me.Height = 180
Test_Progress
Unload Me
Application.Visible = True
End If
End Sub
'*********************************************************************************************
Private Sub CmdThoat_Click()
Unload Me
Workbooks(ThisWorkbook.Name).Close (False)
End Sub
'*********************************************************************************************
Sub ProgressBar(NewValue As Double)
Dim PercentComplete As Integer
PercentComplete = Int(NewValue * 100)
ProgressBar1.Value = PercentComplete
Me.Lbl_Percent = Str(PercentComplete) & "%"
DoEvents
End Sub
Sub Test_Progress()
Dim i As Long, k As Long
k = 20000
For i = 1 To k
Me.ProgressBar (i / k)
DoEvents
Next
Unload Me
End Sub
'*********************************************************************************************
đây là file đính kèm của mình
Mình có một file tên NHA TRO lúc mình viết code để đăng nhập file do mình quên sao lưu ra một file dự trữ. Nên khi viết xong chạy thử thì không vào được file nữa, mong anh chị hướng dẫn xem phần code bị sai chổ nào mà không vào được file.
Đây là phần code của mình cho form đăng nhập, trong đó sheet Nguon ở cột H2=TIẾN MINH, H3=111111, H4=MINH TÂN, H5=170391. Sheet này dùng để lưu User name và password để đăng nhập.
Mong anh chị giúp đở xem có cách nào để mở được file và xem phần code mình viết nó sai chổ nào. rất cám ơn các anh chị
Option Explicit
'*********************************************************************************************
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private isFocus As Boolean, isClose As Byte, Usr As Variant, Pwd As Variant, Usr1 As Variant, Pwd1 As Variant
'*********************************************************************************************
Private Sub UserForm_Initialize()
Workbooks(ThisWorkbook.Name).Activate
Application.EnableCancelKey = xlErrorHandler
Application.Visible = False
Dim hWnd As Long
On Error Resume Next
hWnd = FindWindow("ThunderDFrame", Me.Caption)
SetWindowLong hWnd, -16, &H84080080
Me.Height = 130
Usr = Nguon.[H2].Value
Pwd = Nguon.[H3].Value
Usr1 = Nguon.[H4].Value
Pwd1 = Nguon.[H5].Value
txtUser = Usr
With txtPassword
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
End Sub
Private Sub UserForm_Terminate()
Application.EnableCancelKey = xlInterrupt
End Sub
'*********************************************************************************************
Private Sub txtUser_Enter()
isFocus = True
End Sub
Private Sub txtUser_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
With txtUser
If isFocus Then .SelStart = 0: .SelLength = Len(.Text)
End With
isFocus = False
End Sub
'*********************************************************************************************
Private Sub txtPassword_Enter()
isFocus = True
End Sub
Private Sub txtPassword_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
With txtPassword
If isFocus Then .SelStart = 0: .SelLength = Len(.Text)
End With
isFocus = False
End Sub
'*********************************************************************************************
Private Sub CmdNhap_Click()
isClose = isClose + 1
If isClose = 4 And (txtUser <> Usr Or txtUser <> Usr1 Or txtPassword.Text <> Pwd Or txtPassword.Text <> Pwd1) Then
MsgBox "Rat tiec, ban da nhap 4 lan khong dung User Name hoac Password, " _
& "chuong trinh se tu dong thoat.", vbCritical, "THÔNG BÁO"
CmdThoat_Click
Exit Sub
End If
If txtUser <> Usr Or txtUser <> Usr1 Then
MsgBox "Ban chua nhap dung User Name", vbInformation, "THÔNG BÁO"
With txtUser
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
ElseIf txtPassword.Text <> Pwd Or txtPassword.Text <> Pwd1 Then
isFocus = False
MsgBox "Ban chua nhap dung Password", vbInformation, "THÔNG BÁO"
With txtPassword
.SetFocus: .SelStart = 0: .SelLength = Len(.Text)
End With
Else
Me.Height = 180
Test_Progress
Unload Me
Application.Visible = True
End If
End Sub
'*********************************************************************************************
Private Sub CmdThoat_Click()
Unload Me
Workbooks(ThisWorkbook.Name).Close (False)
End Sub
'*********************************************************************************************
Sub ProgressBar(NewValue As Double)
Dim PercentComplete As Integer
PercentComplete = Int(NewValue * 100)
ProgressBar1.Value = PercentComplete
Me.Lbl_Percent = Str(PercentComplete) & "%"
DoEvents
End Sub
Sub Test_Progress()
Dim i As Long, k As Long
k = 20000
For i = 1 To k
Me.ProgressBar (i / k)
DoEvents
Next
Unload Me
End Sub
'*********************************************************************************************
đây là file đính kèm của mình