列下面的单元格中，然后按下“打印桌签”按钮，就一切OK了。
用VBA实现用户口令及授权管理（源代码公开） 用VBA实现用户口令及授权管理 本人是一个VBA初学者?初次发表自己首个VBA程序, 希望版主及各位前辈给予鼓励, 对予程序中的不足, 希望各位前辈给我改进意见, 用户及口令都为”111” 工程口令已清除 主要功能: 1. 如果用户取消宏, 他就不会看到程序内主表, 在工作表- 隐藏中也取消不了(当然这只能对不懂VBA的用户适用) 2. 系统要求用户定期更改密码 3. 可对不同用户进行不同的授权(在用户表中,Y: 有权; N: 无权 4. 退出系统自动保存 5. 对密码表中的口令加密(希望高手提供更强大的加密算法)
===
Public Function EncodePassword(pw As String) As String
' 传递pw，并返回编码后的pw。
Dim codedPW As String
Dim i As Integer
Dim ch As String * 1
If Len(pw) = 0 Then
EncodePassword = ""
Exit Function
End If
codedPW = ""
pw = Trim(pw)
For i = 1 To Len(pw)
ch = Mid(pw, i, 1)
'codedPW = codedPW & Chr(Asc(ch) + (Cos(i) * i + Sin(200 * i) * i + Log(100 + i * i))) & Chr(Asc(ch) + (Cos(i) * i + Sin(100 * i) * i + Log(50 + i * i)))
'codedPW = codedPW & Chr(Asc(ch) + (Cos(i) + Sin(200 * i))) & Chr(Asc(ch) + (Cos(i) + Sin(100 * i)))
codedPW = codedPW & Chr(Asc(ch) + (Cos(i) * i + Sin(200 * i) * i + Log(100 + i * i) - 1.5 * i)) & Chr(Asc(ch) + (Cos(i) * i + Sin(100 * i) * i + Log(50 + i * i) - 1.5 * i))
Next i
EncodePassword = codedPW
End Function
Public Function DecodePassword(codedPW As String) As String
' 传递编码后的pw，并返回解码的 pw.
Dim decodedPW As String
Dim i As Integer
Dim ch As String * 1
If Len(codedPW) = 0 Then
DecodePassword = ""
Exit Function
End If
decodedPW = ""
codedPW = Trim(codedPW)
For i = 1 To Len(codedPW)
ch = Mid(codedPW, i, 1)
If i Mod 2 = 1 Then
'decodedPW = decodedPW & Chr(Asc(ch) - (Cos((i + 1) / 2) * (i + 1) / 2 + Sin(200 * (i + 1) / 2) * (i + 1) / 2 + Log(100 + (i + 1) / 2 * (i + 1) / 2)))
'decodedPW = decodedPW & Chr(Asc(ch) - (Cos((i + 1) / 2) + Sin(200 * (i + 1) / 2)))
decodedPW = decodedPW & Chr(Asc(ch) - (Cos((i + 1) / 2) * (i + 1) / 2 + Sin(200 * (i + 1) / 2) * (i + 1) / 2 + Log(100 + (i + 1) / 2 * (i + 1) / 2) - (i + 1) / 2 * 1.5))
Else
decodedPW = decodedPW
End If
Next
DecodePassword = decodedPW
End Function
Sub Macro1()
'
' Macro1 Macro
' Wang Jinbo 记录的宏 2004-12-28
'
' 快捷键: Ctrl+z
'
'
' ActiveWorkbook.RefreshAll
' Userform1.Hide
Dim WP19 As Worksheet
Set WP19 = Sheets("WP1019")
Dim Summary As Worksheet
Set Summary = Sheets("Summary")
'Sheets("Summary").Select
'Cells.Select
'Summary.Range(A2, P9999).Select
'Selection.ClearContents
'Selection.Clear
Dim SourceRow As Integer
SourceRow = 2
Dim TargetRow As Integer
TargetRow = 2
Dim OPRow As Integer
OPRow = 2
Dim RevaluationRow As Integer
RevaluationRow = 2
Dim OP As Double