Tại sao bạn không dùng luôn pass Open?
Giả sử tôi mở file của bạn lên và bấm Disable macro... sau đó Alt + F11 và xóa luôn code của bạn thì sao? (đừng nói là đặt pass cho VBA nha... quá vô bổ)
Ơ, sao bảo là kể cả dll và exe cũng bị phá cơ mà.
Ý tôi muốn nói cái này đây:
pen vào code module của chúng ta:
Sub Auto_Open()
On Error GoTo ErrorHandler
'To make sure only the worksheet WsIntro
'that the user can see
Call ViewWs(Array("WsIntro"))
frmLogins.Show
ErrorExit:
If lLogin = 0 Then
'Nham lam cho Excel tuong la da Save roi
'Nen khi dong se khong hoi nua
Application.Workbooks(gcsWbName).Saved = True
Application.Workbooks(gcsWbName).Close
End If
Exit Sub
ErrorHandler:
lLogin = 0
GoTo ErrorExit
End SubOption Explicit
Public Const gcsAppName = "Logins" 'Tên ứng dụng
Public Const gcsWbName = "LoginsExcel.xls" 'Tên tập tin Êxcl
Public lLogin As Long 'Để kiểm tra việc login thành công hay khôngPrivate Sub cmdExit_Click()
lLogin = 0
frmLogins.Hide
End Sub
Private Sub cmdLogin_Click()
Dim sUser As String, sPass As String
Dim sCheck As String, sPermitWs As String
On Error GoTo ErrorHandler
'Gia su rang khong login vao duoc
lLogin = 0
sUser = txtUser.Text
sPass = txtPass.Text
sCheck = GetInfo(sUser, "Logins", 2)
Select Case sCheck
Case "none"
'Trong truong hop nguoi dung khong ton tai
MsgBoxUni VNI("Khoâng toàn taïi ngöôøi duøng " & sUser & vbCrLf & _
"Xin kieåm tra laïi."), vbCritical + vbOKOnly, gcsAppName
Case "error"
'Trong truong hop co loi xay ra
MsgBoxUni VNI("Xin baïn kieåm tra laïi döõ lieäu nhaäp vaøo."), vbInformation + vbOKOnly, gcsAppName
Case Else
'Trong truong hop co ton tai nguoi dung nay
'Kiem tra pass
If sPass <> sCheck Then
MsgBoxUni VNI("Maät khaåu khoâng ñuùng. Xin kieåm laïi."), vbCritical + vbOKOnly, gcsAppName
Else
'Trong truong hop mat khau dung, lay ve gia tri worksheet duoc quyen
sPermitWs = GetInfo(sUser, "Logins", 3)
ViewWs (Array(sPermitWs))
lLogin = 1
Me.Hide
End If
End Select
ErrorExit:
Exit Sub
ErrorHandler:
lLogin = 0
GoTo ErrorExit
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Khong cho thoat bang cach nay
Cancel = True
End SubOption Explicit
Function GetInfo(sName, sWsName As String, Optional ColGetText As Integer = 2) As String
Dim rFound As Range
On Error GoTo ErrorHandler
Set rFound = Sheets(sWsName).Columns(1).Find(sName, lookat:=xlWhole)
If rFound Is Nothing Then
GetInfo = "none"
Else
GetInfo = rFound.Offset(, ColGetText).Value
End If
ErrorExit:
Exit Function
ErrorHandler:
GetInfo = "error"
GoTo ErrorExit
End Function
'---------------------------------------------------------------------------------------
' Procedure : ViewWs
' DateTime :
' Author :
' Purpose : To active the worksheets
' WsName is an array. For example: WsName=Array("Thong bao", "Bao cao")
'---------------------------------------------------------------------------------------
'
Sub ViewWs(ByVal WsName As Variant)
Dim ws As Worksheet
On Error Resume Next
Application.ScreenUpdating = False
'There is at least one worksheet visible first
'If not, the error will be shown and this Sub is not correct
For Each ws In ThisWorkbook.Worksheets
If IsItInArray(ws.Name, WsName, 0) Then
ws.Visible = xlSheetVisible
End If
Next
For Each ws In ThisWorkbook.Worksheets
If Not IsItInArray(ws.Name, WsName, 0) Then
ws.Visible = xlSheetHidden
End If
Next
'To avoid the Take Pane for viewing.
'This error, I have check in the internet but nobody know
With Application
.CommandBars("Task Pane").Visible = True
.CommandBars("Task Pane").Visible = False
.ScreenUpdating = True
End With
End Sub
'---------------------------------------------------------------------------------------
' Procedure : IsItInArray
' DateTime :
' Author : Le Van Duyet
' Purpose : To check an item is in an array or not
' Take note : FoundPos will begin from 0
'---------------------------------------------------------------------------------------
'
Function IsItInArray(sValueToFind As Variant, InputArray As Variant, FoundPos As Long) As Boolean
Dim vloop As Long
On Error GoTo ErrorHandler
For vloop = LBound(InputArray) To UBound(InputArray)
IsItInArray = IIf(StrComp(sValueToFind, InputArray(vloop), vbTextCompare) = 0, True, False)
If IsItInArray Then
FoundPos = vloop
GoTo ErrorExit
End If
Next vloop
ErrorExit:
Exit Function
ErrorHandler:
IsItInArray = False
GoTo ErrorExit
End FunctionFunction GetInfo(sName, sWsName As String, Optional ColGetText As Integer = 2) As StringEm thấy thầy hơi khó tính. Thực ra là thẳng tính thì đúng hơn.
Đúng đây là đề tài các bạn quan tâm tương đối nhiều.
Tôi xin giới thiệu một ví dụ để các bạn tham khảo. Dĩ nhiên ở đây tôi giả sử rằng:
- Không nói đến chuyện bẻ khóa (các loại).
- Có Password cho VBA.
Giả sử rằng chúng ta có các worksheet như hình sau:
Các bạn thấy ta các bảng dữ liệu ở worksheet Logins. Trên bảng này chúng ta lưu trữ :
- MaNV: Mã nhân viên.
- TenNV: Tên nhân viên.
- MatKhau: Mật khẩu.
- Worksheets: Các worksheet được quyền mở.
Tôi sẽ thiết kế một form nhập liệu như hình sau:
Form này đơn giản, chỉ có 2 Textbox giúp cho người dùng nhập vào tên và mật khẩu.
Để bắt buộc người dùng đăng nhập vào để sử dụng các bạn sẽ phải cho hiện form đăng nhập mỗi khi người dùng. Chú ý, phải bắt buộc người dùng Enable macro thì chúng ta mới cho sử dụng tập tin (tham khảo thêm tại đây)
Chúng ta sẽ thêm thủ tục Aut
Mã:Sub Auto_Open() On Error GoTo ErrorHandler 'To make sure only the worksheet WsIntro 'that the user can see Call ViewWs(Array("WsIntro")) frmLogins.Show ErrorExit: If lLogin = 0 Then 'Nham lam cho Excel tuong la da Save roi 'Nen khi dong se khong hoi nua Application.Workbooks(gcsWbName).Saved = True Application.Workbooks(gcsWbName).Close End If Exit Sub ErrorHandler: lLogin = 0 GoTo ErrorExit End Sub
Chú ý: chúng ta có các hằng và biến cho chương trình như sau:
Mã:Option Explicit Public Const gcsAppName = "Logins" 'Tên ứng dụng Public Const gcsWbName = "LoginsExcel.xls" 'Tên tập tin Êxcl Public lLogin As Long 'Để kiểm tra việc login thành công hay không
Và bây giờ chúng ta hãy viết code cho form đăng nhập ở trên:
Mã:Private Sub cmdExit_Click() lLogin = 0 frmLogins.Hide End Sub Private Sub cmdLogin_Click() Dim sUser As String, sPass As String Dim sCheck As String, sPermitWs As String On Error GoTo ErrorHandler 'Gia su rang khong login vao duoc lLogin = 0 sUser = txtUser.Text sPass = txtPass.Text sCheck = GetInfo(sUser, "Logins", 2) Select Case sCheck Case "none" 'Trong truong hop nguoi dung khong ton tai MsgBoxUni VNI("Khoâng toàn taïi ngöôøi duøng " & sUser & vbCrLf & _ "Xin kieåm tra laïi."), vbCritical + vbOKOnly, gcsAppName Case "error" 'Trong truong hop co loi xay ra MsgBoxUni VNI("Xin baïn kieåm tra laïi döõ lieäu nhaäp vaøo."), vbInformation + vbOKOnly, gcsAppName Case Else 'Trong truong hop co ton tai nguoi dung nay 'Kiem tra pass If sPass <> sCheck Then MsgBoxUni VNI("Maät khaåu khoâng ñuùng. Xin kieåm laïi."), vbCritical + vbOKOnly, gcsAppName Else 'Trong truong hop mat khau dung, lay ve gia tri worksheet duoc quyen sPermitWs = GetInfo(sUser, "Logins", 3) ViewWs (Array(sPermitWs)) lLogin = 1 Me.Hide End If End Select ErrorExit: Exit Sub ErrorHandler: lLogin = 0 GoTo ErrorExit End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'Khong cho thoat bang cach nay Cancel = True End Sub
LVD
Thầy hướng dẫn
Thực sự em đã cố gắng tìm hiểu để đạt được vấn đề mong muốn là gán số lượng sheet cần mở lên 1 user ( 1 user có thể 1 hoặc 2 hoặc 3 sheets tùy vào mình muốn set), nhưng lực bất tòng tâm, mong thầy bớt chút thời gian hướng dẫn giúp ạ. Cảm ơn thầy
Muốn phần user1 có thêm nhiều sheet mới thì làm sao vậy a?
Quan trọng là các câu lệnh trong nút nhấn "Đăng nhập". Nếu sheet bị khoá, bị ẩn, không cho thao tác trên bảng tính thì phải nhấn nút "Đăng nhập" mới được gỡ khoá (nếu đúng mật khẩu). Nhấn dấu X thì không mở khoá.
