3、登录验证程序

登录验证源代码

Public blogin As Boolean
Sub yanzheng()
Dim bmodi
Dim i, j, r, c
Static icount As Integer
Dim suser, spwd
Dim yuan2 As Range
On Error Resume Next
ThisWorkbook.Unprotect ("123") '解锁
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
If Sheets(i).Name <> "主界面" Then Sheets(i).Visible = 2
Next
If icount > 3 Then
MsgBox "登录次数超过三次，即将退出系统！！！"
ThisWorkbook.Close
Exit Sub
End If
icount = icount + 1
suser = 登录.ComboBox1.Text
spwd = 登录.txtpassword.Text
If suser = "" Then
MsgBox "系统无此用户，请通知系统维护员"
Exit Sub
End If
Set yuan2 = Sheets("权限表").UsedRange.Find("用户名称")
If yuan2 Is Nothing Then
MsgBox "系统错误，请通知系统维护员！！！"
Exit Sub
End If
Set yuan2 = yuan2.EntireColumn.Find(suser)
If spwd = "" Or CStr(yuan2) = "" Or spwd <> yuan2.Cells(1, 2).Text Then
MsgBox "用户名或密码错误，请重新登录！"
On Error GoTo 0
Exit Sub
End If
icount = 0

r = yuan2.Row
bmodi = Sheets("权限表").Cells(r, 3)
If bmodi = "A" Then
unsheetp
xuliea
Else
If bmodi = "B" Then
sheetp1
xuliea

Else
Sheets("结算利润表(城市)").Range("a2").Value = bmodi
Sheets("上数利润表(城市)").Range("a2").Value = bmodi
Sheets("查询表").Range("b1").Value = bmodi
sheetp
Sheets("查询表").Range("b1").Validation.Delete
Sheets("结算利润表(城市)").Range("a2").Validation.Delete
Sheets("上数利润表(城市)").Range("a2").Validation.Delete
lock2
End If
End If
Application.ScreenUpdating = ture
blogin = True
End Sub
Sub unsheetp()
For i = 1 To Sheets.Count
If Sheets(i).Name <> "" Then Sheets(i).Visible = -1
Next
For i = 1 To Sheets.Count
If Sheets(i).Name <> "" Then Sheets(i).Unprotect ("123")
Next
End Sub
Sub sheetp1()
For i = 1 To Sheets.Count
If Sheets(i).Name <> "主界面" Then Sheets(i).Protect ("123") '加锁
Next
For i = 1 To Sheets.Count
If Sheets(i).Name = "主界面" Or Sheets(i).Name = "结算利润表" Or Sheets(i).Name = "上数利润表" Or Sheets(i).Name = "结算利润表(城市)" Or Sheets(i).Name = "上数利润表(城市)" Or Sheets(i).Name = "查询表" Then Sheets(i).Unprotect ("123") '解锁
Next
Sheets("主界面").Range("a20:q20").Interior.ColorIndex = 2
Sheets("主界面").Range("a20:q20").Font.ColorIndex = 2
Sheets("主界面").Range("g14").Font.ColorIndex = 6
For i = 1 To Sheets.Count
If Sheets(i).Name = "主界面" Or Sheets(i).Name = "结算利润表" Or Sheets(i).Name = "上数利润表" Or Sheets(i).Name = "结算利润表(城市)" Or Sheets(i).Name = "上数利润表(城市)" Or Sheets(i).Name = "查询表" Then Sheets(i).Visible = -1
Next
blogin = True

End Sub
Sub sheetp()
For i = 1 To Sheets.Count
If Sheets(i).Name = "主界面" Or Sheets(i).Name = "结算利润表(城市)" Or Sheets(i).Name = "上数利润表(城市)" Or Sheets(i).Name = "查询表" Then Sheets(i).Unprotect ("123")
Next
Sheets("主界面").Range("a14:q14").Interior.ColorIndex = 2
Sheets("主界面").Range("a14:q14").Font.ColorIndex = 2
Sheets("主界面").Range("a20:q20").Interior.ColorIndex = 2
Sheets("主界面").Range("a20:q20").Font.ColorIndex = 2
Sheets("主界面").Range("g14").Font.ColorIndex = 2
For i = 1 To Sheets.Count
If Sheets(i).Name = "主界面" Or Sheets(i).Name = "结算利润表(城市)" Or Sheets(i).Name = "上数利润表(城市)" Or Sheets(i).Name = "查询表" Then Sheets(i).Visible = -1
Next
blogin = True
End Sub
Sub lock2()
On Error Resume Next
With Sheets("查询表")
'.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域3", Range:=Range("c1:xfd1")
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("B2:xfd1048576")
.Protection.AllowEditRanges.Add Title:="区域2", Range:=Range("a1:a1048576")
.Protection.AllowEditRanges.Add Title:="区域4", Range:=Range("B2:xfd2")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
End With
With Sheets("结算利润表(城市)")
.Protection.AllowEditRanges(1).Delete
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
With Sheets("上数利润表(城市)")
.Protection.AllowEditRanges(1).Delete
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub
Sub lock1()
On Error Resume Next
With Sheets("结算利润表")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A1")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With

With Sheets("上数利润表")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A1")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With

End Sub

Sub xuliea()
Dim a, s As Long
Dim ll As Long, xulie As String, sht As Worksheet
a = Sheets("权限表").Range("d65536").End(xlUp).Row
s = Sheets("权限表").Range("d1").End(xlDown).Row
For ll = s To a
If Sheets("权限表").Cells(ll, 4) = "A" Then xulie = xulie & Sheets("权限表").Cells(ll, 3) & ","
Next
With Sheets("查询表").Range("c1").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=xulie
End With
With Sheets("结算利润表(城市)").Range("a2").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=xulie
End With
With Sheets("上数利润表(城市)").Range("a2").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=xulie
End With
End Sub
Sub xuliedeleteb()
Sheets("查询表").Range("c1").Validation.Delete
Sheets("结算利润表(城市)").Range("a2").Validation.Delete
Sheets("上数利润表(城市)").Range("a2").Validation.Delete
End Sub
Sub testlock()
'On Error Resume Next
On Error GoTo oo1
With Sheets("结算利润表(城市)")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A2")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
oo1: With Sheets("结算利润表(城市)")
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A2")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
End Sub
Sub lock4()
On Error Resume Next
With Sheets("结算利润表")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A1")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
With Sheets("上数利润表")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A1")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
With Sheets("结算利润表(城市)")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A2")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
With Sheets("上数利润表(城市)")
.Protection.AllowEditRanges(1).Delete
.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range("A2")
.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
End With
End Sub