[VBA]Excel 人员信息管理

最新推荐文章于 2022-07-05 11:49:25 发布

Tony.Zhou

最新推荐文章于 2022-07-05 11:49:25 发布

阅读量2.3k

点赞数 6

文章标签： VBA

原文链接：https://www.cnblogs.com/XH16/p/5362291.html

版权

系统截图：

登录窗体加载代码：

 Sub Auto_Open()
   '自动加载窗体
   login.Show
   End Sub

“统计”按钮

Sub 按钮1_单击()
 
 '查看总记录数
 
 x = 2 '数据源表中第一条记录所在的行号
 Dim counts As Integer
 counts = 0
 Do While Sheet1.Cells(x, 2) <> "" '当遇到空行时结束
 counts = counts + 1
 x = x + 1
 Loop
 Sheet4.Cells(5, 5) = counts '将总的记录数保存到指定单元格
 End Sub

打印所选人员信息

Sub 按钮2_单击()

'执行打印选择人员基本信息


xm = Sheet4.Cells(7, 5) '从 系统功能表 中获取选择的姓名

If xm = "" Then '如果未选择，则提示选择
MsgBox "请选择人员！"
End If

'从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
rowxm = 0 '初始值为0
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))

If xm = Sheet1.Cells(i, 2) Then
rowxm = i
'MsgBox "所在行号为:" + Trim(Str(i))
Exit Do
End If
i = i + 1
Loop


If rowxm <> 0 Then
'打印提示信息,flag2的值有两个:1表示打印,2表示不打印
flag2 = MsgBox("您将打印" & xm & "的基本信息！", 1)

If flag2 = 1 Then

Sheet2.Visible = True
Sheet2.Activate


'将 基本数据表 中的相关信息填充到 打印 表中的相应位置
Sheet2.Cells(2, 2) = Sheet1.Cells(rowxm, 1) '单位
Sheet2.Cells(3, 2) = Sheet1.Cells(rowxm, 2) '姓名
Sheet2.Cells(3, 5) = Sheet1.Cells(rowxm, 3) '性别
Sheet2.Cells(4, 2) = Sheet1.Cells(rowxm, 4) '民族
Sheet2.Cells(4, 4) = Sheet1.Cells(rowxm, 5) '政治面貌
Sheet2.Cells(5, 2) = Sheet1.Cells(rowxm, 6) '出生日期
Sheet2.Cells(5, 4) = Sheet1.Cells(rowxm, 7) '出生地
Sheet2.Cells(6, 2) = Sheet1.Cells(rowxm, 8) '毕业学校
Sheet2.Cells(7, 2) = Sheet1.Cells(rowxm, 9) '所学专业
Sheet2.Cells(8, 2) = Sheet1.Cells(rowxm, 10) '学位
Sheet2.Cells(8, 7) = Sheet1.Cells(rowxm, 11) '学历
Sheet2.Cells(9, 2) = Sheet1.Cells(rowxm, 12) '现职业
Sheet2.Cells(9, 7) = Sheet1.Cells(rowxm, 13) '职务
Sheet2.Cells(10, 2) = Sheet1.Cells(rowxm, 14) '地址
Sheet2.Cells(10, 8) = Sheet1.Cells(rowxm, 15) '邮编
Sheet2.Cells(11, 2) = Sheet1.Cells(rowxm, 16) '电话
Sheet2.Cells(11, 7) = Sheet1.Cells(rowxm, 17) '邮箱
Sheet2.Cells(12, 3) = Sheet1.Cells(rowxm, 18) '学科
Sheet2.Cells(13, 3) = Sheet1.Cells(rowxm, 19) '身份证
Sheet2.Cells(16, 1) = Sheet1.Cells(rowxm, 20)
Sheet2.Cells(16, 7) = Sheet1.Cells(rowxm, 21)
Sheet2.Cells(16, 3) = Sheet1.Cells(rowxm, 22)
Sheet2.Cells(16, 8) = Sheet1.Cells(rowxm, 23)
Sheet2.Cells(17, 1) = Sheet1.Cells(rowxm, 24)
Sheet2.Cells(17, 7) = Sheet1.Cells(rowxm, 25)
Sheet2.Cells(17, 3) = Sheet1.Cells(rowxm, 26)
Sheet2.Cells(17, 8) = Sheet1.Cells(rowxm, 27)
Sheet2.Cells(18, 1) = Sheet1.Cells(rowxm, 28)
Sheet2.Cells(18, 7) = Sheet1.Cells(rowxm, 29)
Sheet2.Cells(18, 3) = Sheet1.Cells(rowxm, 30)
Sheet2.Cells(18, 8) = Sheet1.Cells(rowxm, 31)
Sheet2.Cells(19, 1) = Sheet1.Cells(rowxm, 32)
Sheet2.Cells(19, 7) = Sheet1.Cells(rowxm, 33)
Sheet2.Cells(19, 3) = Sheet1.Cells(rowxm, 34)
Sheet2.Cells(19, 8) = Sheet1.Cells(rowxm, 35)
Sheet2.Cells(20, 3) = Sheet1.Cells(rowxm, 36)
Sheet2.Cells(21, 3) = Sheet1.Cells(rowxm, 37)
Sheet2.Cells(22, 3) = Sheet1.Cells(rowxm, 38)
Sheet2.Cells(23, 3) = Sheet1.Cells(rowxm, 39)
Sheet2.Cells(3, 8) = ""
'照片处理
ActiveSheet.Pictures.Delete '删除之前的照片
Dim MyFile As Object
Set MyFile = CreateObject("Scripting.FileSystemObject")
If MyFile.FileExists(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg") = True Then
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
Else
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\shili.jpg").Select
End If
With Selection
.Top = Range("H3:H7").Top + 2
.Left = Range("H3:H7").Left + 3

.Height = Range("H3:H7").Height - 4
.Width = Range("H3:H7").Width - 4
End With


Range("A1:H23").Select
ActiveWindow.SelectedSheets.PrintPreview '打印预览
'Selection.PrintOut Copies:=1, Collate:=True

Sheet2.Visible = False
Sheet4.Activate

Else
MsgBox "您已取消打印~！"
End If 'flag2判断是否打印 结束
End If '选择的姓名存在对应的行号

Sheet4.Cells(7, 5) = Sheet1.Cells(2, 2)
End Sub

“修改”所选人员信息视图

Sub 按钮3_单击()

'修改一人---视图

xm = Sheet4.Cells(9, 5) '从 系统功能表 中获取选择的姓名
If xm = "" Then '如果未选择，则提示选择
MsgBox "请选择人员！"
End If

'从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
rowxm = 0 '初始值为0
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))

If xm = Sheet1.Cells(i, 2) Then
rowxm = i
'MsgBox "所在行号为:" + Trim(Str(i))
Exit Do
End If
i = i + 1
Loop


If rowxm <> 0 Then '找到之后

Sheet6.Visible = True
Sheet6.Activate


'将 基本数据表 中的相关信息填充到 打印 表中的相应位置
Sheet6.Cells(2, 2) = Sheet1.Cells(rowxm, 1) '单位
Sheet6.Cells(3, 2) = Sheet1.Cells(rowxm, 2) '姓名
Sheet6.Cells(3, 5) = Sheet1.Cells(rowxm, 3) '性别
Sheet6.Cells(4, 2) = Sheet1.Cells(rowxm, 4) '民族
Sheet6.Cells(4, 4) = Sheet1.Cells(rowxm, 5) '政治面貌
Sheet6.Cells(5, 2) = Sheet1.Cells(rowxm, 6) '出生日期
Sheet6.Cells(5, 4) = Sheet1.Cells(rowxm, 7) '出生地
Sheet6.Cells(6, 2) = Sheet1.Cells(rowxm, 8) '毕业学校
Sheet6.Cells(7, 2) = Sheet1.Cells(rowxm, 9) '所学专业
Sheet6.Cells(8, 2) = Sheet1.Cells(rowxm, 10) '学位
Sheet6.Cells(8, 7) = Sheet1.Cells(rowxm, 11) '学历
Sheet6.Cells(9, 2) = Sheet1.Cells(rowxm, 12) '现职业
Sheet6.Cells(9, 7) = Sheet1.Cells(rowxm, 13) '职务
Sheet6.Cells(10, 2) = Sheet1.Cells(rowxm, 14) '地址
Sheet6.Cells(10, 8) = Sheet1.Cells(rowxm, 15) '邮编
Sheet6.Cells(11, 2) = Sheet1.Cells(rowxm, 16) '电话
Sheet6.Cells(11, 7) = Sheet1.Cells(rowxm, 17) '邮箱
Sheet6.Cells(12, 3) = Sheet1.Cells(rowxm, 18) '学科
Sheet6.Cells(13, 3) = Sheet1.Cells(rowxm, 19) '身份证
Sheet6.Cells(16, 1) = Sheet1.Cells(rowxm, 20)
Sheet6.Cells(16, 7) = Sheet1.Cells(rowxm, 21)
Sheet6.Cells(16, 3) = Sheet1.Cells(rowxm, 22)
Sheet6.Cells(16, 8) = Sheet1.Cells(rowxm, 23)
Sheet6.Cells(17, 1) = Sheet1.Cells(rowxm, 24)
Sheet6.Cells(17, 7) = Sheet1.Cells(rowxm, 25)
Sheet6.Cells(17, 3) = Sheet1.Cells(rowxm, 26)
Sheet6.Cells(17, 8) = Sheet1.Cells(rowxm, 27)
Sheet6.Cells(18, 1) = Sheet1.Cells(rowxm, 28)
Sheet6.Cells(18, 7) = Sheet1.Cells(rowxm, 29)
Sheet6.Cells(18, 3) = Sheet1.Cells(rowxm, 30)
Sheet6.Cells(18, 8) = Sheet1.Cells(rowxm, 31)
Sheet6.Cells(19, 1) = Sheet1.Cells(rowxm, 32)
Sheet6.Cells(19, 7) = Sheet1.Cells(rowxm, 33)
Sheet6.Cells(19, 3) = Sheet1.Cells(rowxm, 34)
Sheet6.Cells(19, 8) = Sheet1.Cells(rowxm, 35)
Sheet6.Cells(20, 3) = Sheet1.Cells(rowxm, 36)
Sheet6.Cells(21, 3) = Sheet1.Cells(rowxm, 37)
Sheet6.Cells(22, 3) = Sheet1.Cells(rowxm, 38)
Sheet6.Cells(23, 3) = Sheet1.Cells(rowxm, 39)


End If '选择的姓名存在对应的行号
Sheet4.Cells(9, 5) = Sheet1.Cells(2, 2)
End Sub

“修改”所选人员信息：处理

Sub 按钮3_1_单击()

'修改一人---提交修改

Sheet6.Activate
ActiveWorkbook.Save '将修改进行系统保存
xm = Sheet6.Cells(3, 2)
'从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
rowxm = 0 '初始值为0
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))

If xm = Sheet1.Cells(i, 2) Then
rowxm = i
'MsgBox "所在行号为:" + Trim(Str(i))
Exit Do
End If
i = i + 1
Loop

If rowxm <> 0 Then '找到之后，写到基本数据表相应行中

'将 基本数据表 中的相关信息填充到 打印 表中的相应位置
Sheet1.Cells(rowxm, 1) = Sheet6.Cells(2, 2) '单位
'Sheet1.Cells(rowxm, 2) = Sheet6.Cells(3, 2) '姓名不改变
Sheet1.Cells(rowxm, 3) = Sheet6.Cells(3, 5) '性别
Sheet1.Cells(rowxm, 4) = Sheet6.Cells(4, 2)
Sheet1.Cells(rowxm, 5) = Sheet6.Cells(4, 4)
Sheet1.Cells(rowxm, 6) = Sheet6.Cells(5, 2)
Sheet1.Cells(rowxm, 7) = Sheet6.Cells(5, 4)
Sheet1.Cells(rowxm, 8) = Sheet6.Cells(6, 2)
Sheet1.Cells(rowxm, 9) = Sheet6.Cells(7, 2)
Sheet1.Cells(rowxm, 10) = Sheet6.Cells(8, 2)
Sheet1.Cells(rowxm, 11) = Sheet6.Cells(8, 7)
Sheet1.Cells(rowxm, 12) = Sheet6.Cells(9, 2)
Sheet1.Cells(rowxm, 13) = Sheet6.Cells(9, 7)
Sheet1.Cells(rowxm, 14) = Sheet6.Cells(10, 2)
Sheet1.Cells(rowxm, 15) = Sheet6.Cells(10, 8)
Sheet1.Cells(rowxm, 16) = Sheet6.Cells(11, 2)
Sheet1.Cells(rowxm, 17) = Sheet6.Cells(11, 7)
Sheet1.Cells(rowxm, 18) = Sheet6.Cells(12, 3)
Sheet1.Cells(rowxm, 19) = Sheet6.Cells(13, 3)
Sheet1.Cells(rowxm, 20) = Sheet6.Cells(16, 1)
Sheet1.Cells(rowxm, 21) = Sheet6.Cells(16, 7)
Sheet1.Cells(rowxm, 22) = Sheet6.Cells(16, 3)
Sheet1.Cells(rowxm, 23) = Sheet6.Cells(16, 8)
Sheet1.Cells(rowxm, 24) = Sheet6.Cells(17, 1)
Sheet1.Cells(rowxm, 25) = Sheet6.Cells(17, 7)
Sheet1.Cells(rowxm, 26) = Sheet6.Cells(17, 3)
Sheet1.Cells(rowxm, 27) = Sheet6.Cells(17, 8)
Sheet1.Cells(rowxm, 28) = Sheet6.Cells(18, 1)
Sheet1.Cells(rowxm, 29) = Sheet6.Cells(18, 7)
Sheet1.Cells(rowxm, 30) = Sheet6.Cells(18, 3)
Sheet1.Cells(rowxm, 31) = Sheet6.Cells(18, 8)
Sheet1.Cells(rowxm, 32) = Sheet6.Cells(19, 1)
Sheet1.Cells(rowxm, 33) = Sheet6.Cells(19, 7)
Sheet1.Cells(rowxm, 34) = Sheet6.Cells(19, 3)
Sheet1.Cells(rowxm, 35) = Sheet6.Cells(19, 8)
Sheet1.Cells(rowxm, 36) = Sheet6.Cells(20, 3)
Sheet1.Cells(rowxm, 37) = Sheet6.Cells(21, 3)
Sheet1.Cells(rowxm, 38) = Sheet6.Cells(22, 3)
Sheet1.Cells(rowxm, 39) = Sheet6.Cells(23, 3)

End If '选择的姓名存在对应的行号

Sheet6.Visible = False
Sheet4.Activate

End Sub

“删除”所选人员信息

Sub 按钮4_单击()

'删除选择人员
xm = Sheet4.Cells(11, 5) '从 系统功能表 中获取选择的姓名
If xm = "" Then '如果未选择，则提示选择
MsgBox "请选择人员！"
End If

'从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
rowxm = 0 '初始值为0
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))

If xm = Sheet1.Cells(i, 2) Then
rowxm = i
'MsgBox "所在行号为:" + Trim(Str(i))
Exit Do
End If
i = i + 1
Loop


If rowxm <> 0 Then '找到之后删除
flag2 = MsgBox("您确定要删除" & xm & "的基本信息！", 1)
If flag2 = 1 Then
'Sheet1.Visible = True
Sheet1.Activate
Rows(rowxm & ":" & rowxm).Select
Selection.Delete Shift:=xlUp
ActiveWorkbook.Save '数据保存
Else
MsgBox ("您已取消删除！")
End If
End If '选择的姓名存在对应的行号
Sheet4.Cells(11, 5) = Sheet1.Cells(2, 2)

'重新统计人数
x = 2 '数据源表中第一条记录所在的行号
Dim counts As Integer
counts = 0
Do While Sheet1.Cells(x, 2) <> "" '当遇到空行时结束
counts = counts + 1
x = x + 1
Loop
Sheet4.Cells(5, 5) = counts '将总的记录数保存到指定单元格

'Sheet1.Visible = False
Sheet4.Activate
End Sub

“打印所有人员信息”

Sub 按钮5_单击()

'执行打印所有人员信息

'找到最后一条记录的行号，保存到rowxm中
flag = 1 '1表示是一个新人，2表示已经存在
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))
i = i + 1
Loop
rowxm = i - 1

'打印提示信息,flag2的值有两个:1表示打印,2表示不打印
flag2 = MsgBox("您将打印" & (i - 2) & "名人员基本信息表！", 1)

If flag2 = 1 Then

Sheet2.Visible = True
Sheet2.Activate
For i = 2 To rowxm
On Error GoTo over '对用户打印过程中取消打印时的处理
'将 基本数据表 中的相关信息填充到 打印 表中的相应位置
Sheet2.Cells(2, 2) = Sheet1.Cells(i, 1) '单位
Sheet2.Cells(3, 2) = Sheet1.Cells(i, 2) '姓名
Sheet2.Cells(3, 5) = Sheet1.Cells(i, 3) '性别
Sheet2.Cells(4, 2) = Sheet1.Cells(i, 4) '民族
Sheet2.Cells(4, 4) = Sheet1.Cells(i, 5) '政治面貌
Sheet2.Cells(5, 2) = Sheet1.Cells(i, 6) '出生日期
Sheet2.Cells(5, 4) = Sheet1.Cells(i, 7) '出生地
Sheet2.Cells(6, 2) = Sheet1.Cells(i, 8) '毕业学校
Sheet2.Cells(7, 2) = Sheet1.Cells(i, 9) '所学专业
Sheet2.Cells(8, 2) = Sheet1.Cells(i, 10) '学位
Sheet2.Cells(8, 7) = Sheet1.Cells(i, 11) '学历
Sheet2.Cells(9, 2) = Sheet1.Cells(i, 12) '现职业
Sheet2.Cells(9, 7) = Sheet1.Cells(i, 13) '职务
Sheet2.Cells(10, 2) = Sheet1.Cells(i, 14) '地址
Sheet2.Cells(10, 8) = Sheet1.Cells(i, 15) '邮编
Sheet2.Cells(11, 2) = Sheet1.Cells(i, 16) '电话
Sheet2.Cells(11, 7) = Sheet1.Cells(i, 17) '邮箱
Sheet2.Cells(12, 3) = Sheet1.Cells(i, 18) '学科
Sheet2.Cells(13, 3) = Sheet1.Cells(i, 19) '身份证
Sheet2.Cells(16, 1) = Sheet1.Cells(i, 20)
Sheet2.Cells(16, 7) = Sheet1.Cells(i, 21)
Sheet2.Cells(16, 3) = Sheet1.Cells(i, 22)
Sheet2.Cells(16, 8) = Sheet1.Cells(i, 23)
Sheet2.Cells(17, 1) = Sheet1.Cells(i, 24)
Sheet2.Cells(17, 7) = Sheet1.Cells(i, 25)
Sheet2.Cells(17, 3) = Sheet1.Cells(i, 26)
Sheet2.Cells(17, 8) = Sheet1.Cells(i, 27)
Sheet2.Cells(18, 1) = Sheet1.Cells(i, 28)
Sheet2.Cells(18, 7) = Sheet1.Cells(i, 29)
Sheet2.Cells(18, 3) = Sheet1.Cells(i, 30)
Sheet2.Cells(18, 8) = Sheet1.Cells(i, 31)
Sheet2.Cells(19, 1) = Sheet1.Cells(i, 32)
Sheet2.Cells(19, 7) = Sheet1.Cells(i, 33)
Sheet2.Cells(19, 3) = Sheet1.Cells(i, 34)
Sheet2.Cells(19, 8) = Sheet1.Cells(i, 35)
Sheet2.Cells(20, 3) = Sheet1.Cells(i, 36)
Sheet2.Cells(21, 3) = Sheet1.Cells(i, 37)
Sheet2.Cells(22, 3) = Sheet1.Cells(i, 38)
Sheet2.Cells(23, 3) = Sheet1.Cells(i, 39)
Sheet2.Cells(3, 8) = ""
'照片处理
ActiveSheet.Pictures.Delete '删除之前的照片
Dim MyFile As Object
Set MyFile = CreateObject("Scripting.FileSystemObject")
If MyFile.FileExists(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg") = True Then
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
Else
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\shili.jpg").Select
End If

'ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
With Selection
.Top = Range("H3:H7").Top
.Left = Range("H3:H7").Left

.Height = Range("H3:H7").Height
.Width = Range("H3:H7").Width
End With

Range("A1:H23").Select
Selection.PrintOut Copies:=1, Collate:=True

Next
over: '对用户打印过程中取消打印时的处理
Sheet2.Visible = False
Sheet4.Activate


Else
MsgBox "您已取消打印~！"
End If 'flag2判断是否打印 结束

End Sub

“查看基本表”信息

Sub 按钮6_单击()

'查看基本数据表
'密码验证
Dim mm As String

mm = InputBox("请输入系统登录密码：", 信息查看前验证, "")
If mm = "" Then
MsgBox "请输入系统登录密码，通过后方可查看！"
Exit Sub
End If
If mm <> Sheet5.Cells(2, 2) Then
MsgBox "密码错误！"
Exit Sub
End If

If mm = Sheet5.Cells(2, 2) Then
Sheet1.Visible = True
Sheet1.Activate
End If

End Sub

“隐藏”基本数据表

Sub 按钮7_单击()

'隐藏基本数据表

Sheet1.Visible = False
Sheet4.Activate

End Sub

“添加一人”视图

Sub 按钮8_单击()

'添加一人---视图
Sheet6.Visible = True
Sheet6.Activate
'清空添加表中输入的数据
Sheet6.Cells(2, 2) = ""
Sheet6.Cells(3, 2) = ""
Sheet6.Cells(3, 5) = ""
Sheet6.Cells(4, 2) = ""
Sheet6.Cells(4, 4) = ""
Sheet6.Cells(5, 2) = ""
Sheet6.Cells(5, 4) = ""
Sheet6.Cells(6, 2) = ""
Sheet6.Cells(7, 2) = ""
Sheet6.Cells(8, 2) = ""
Sheet6.Cells(8, 7) = ""
Sheet6.Cells(9, 2) = ""
Sheet6.Cells(9, 7) = ""
Sheet6.Cells(10, 2) = ""
Sheet6.Cells(10, 8) = ""
Sheet6.Cells(11, 2) = ""
Sheet6.Cells(11, 7) = ""
Sheet6.Cells(12, 3) = ""
Sheet6.Cells(13, 3) = ""
Sheet6.Cells(16, 1) = ""
Sheet6.Cells(16, 7) = ""
Sheet6.Cells(16, 3) = ""
Sheet6.Cells(16, 8) = ""
Sheet6.Cells(17, 1) = ""
Sheet6.Cells(17, 7) = ""
Sheet6.Cells(17, 3) = ""
Sheet6.Cells(17, 8) = ""
Sheet6.Cells(18, 1) = ""
Sheet6.Cells(18, 7) = ""
Sheet6.Cells(18, 3) = ""
Sheet6.Cells(18, 8) = ""
Sheet6.Cells(19, 1) = ""
Sheet6.Cells(19, 7) = ""
Sheet6.Cells(19, 3) = ""
Sheet6.Cells(19, 8) = ""
Sheet6.Cells(20, 3) = ""
Sheet6.Cells(21, 3) = ""
Sheet6.Cells(22, 3) = ""
Sheet6.Cells(23, 3) = ""

End Sub

“添加一人”处理：

Sub 按钮8_1_单击()

'添加一人---提交添加

Sheet6.Activate '确保添加工作表处于激活状态
ActiveWorkbook.Save '将 添加工作表 进行系统保存

xm = Sheet6.Cells(3, 2) '检查该人员是否已经存在

'找到第一个出现的空行的行号，保存到rowxm中
flag = 1 '1表示是一个新人，2表示已经存在
i = 2
Do While Not IsEmpty(Sheet1.Cells(i, 2))
If xm = Sheet1.Cells(i, 2) Then
flag = 2
MsgBox "该人员已经存在,请修改后重新添加！"
Exit Do
End If
i = i + 1
Loop
rowxm = i

If flag = 1 Then '是新人员，'将输入的基本信息保存到 基本数据表 中


Sheet1.Cells(rowxm, 1) = Sheet6.Cells(2, 2) '单位
Sheet1.Cells(rowxm, 2) = Sheet6.Cells(3, 2) '姓名不改变
Sheet1.Cells(rowxm, 3) = Sheet6.Cells(3, 5) '性别
Sheet1.Cells(rowxm, 4) = Sheet6.Cells(4, 2)
Sheet1.Cells(rowxm, 5) = Sheet6.Cells(4, 4)
Sheet1.Cells(rowxm, 6) = Sheet6.Cells(5, 2)
Sheet1.Cells(rowxm, 7) = Sheet6.Cells(5, 4)
Sheet1.Cells(rowxm, 8) = Sheet6.Cells(6, 2)
Sheet1.Cells(rowxm, 9) = Sheet6.Cells(7, 2)
Sheet1.Cells(rowxm, 10) = Sheet6.Cells(8, 2)
Sheet1.Cells(rowxm, 11) = Sheet6.Cells(8, 7)
Sheet1.Cells(rowxm, 12) = Sheet6.Cells(9, 2)
Sheet1.Cells(rowxm, 13) = Sheet6.Cells(9, 7)
Sheet1.Cells(rowxm, 14) = Sheet6.Cells(10, 2)
Sheet1.Cells(rowxm, 15) = Sheet6.Cells(10, 8)
Sheet1.Cells(rowxm, 16) = Sheet6.Cells(11, 2)
Sheet1.Cells(rowxm, 17) = Sheet6.Cells(11, 7)
Sheet1.Cells(rowxm, 18) = Sheet6.Cells(12, 3)
Sheet1.Cells(rowxm, 19) = Sheet6.Cells(13, 3)
Sheet1.Cells(rowxm, 20) = Sheet6.Cells(16, 1)
Sheet1.Cells(rowxm, 21) = Sheet6.Cells(16, 7)
Sheet1.Cells(rowxm, 22) = Sheet6.Cells(16, 3)
Sheet1.Cells(rowxm, 23) = Sheet6.Cells(16, 8)
Sheet1.Cells(rowxm, 24) = Sheet6.Cells(17, 1)
Sheet1.Cells(rowxm, 25) = Sheet6.Cells(17, 7)
Sheet1.Cells(rowxm, 26) = Sheet6.Cells(17, 3)
Sheet1.Cells(rowxm, 27) = Sheet6.Cells(17, 8)
Sheet1.Cells(rowxm, 28) = Sheet6.Cells(18, 1)
Sheet1.Cells(rowxm, 29) = Sheet6.Cells(18, 7)
Sheet1.Cells(rowxm, 30) = Sheet6.Cells(18, 3)
Sheet1.Cells(rowxm, 31) = Sheet6.Cells(18, 8)
Sheet1.Cells(rowxm, 32) = Sheet6.Cells(19, 1)
Sheet1.Cells(rowxm, 33) = Sheet6.Cells(19, 7)
Sheet1.Cells(rowxm, 34) = Sheet6.Cells(19, 3)
Sheet1.Cells(rowxm, 35) = Sheet6.Cells(19, 8)
Sheet1.Cells(rowxm, 36) = Sheet6.Cells(20, 3)
Sheet1.Cells(rowxm, 37) = Sheet6.Cells(21, 3)
Sheet1.Cells(rowxm, 38) = Sheet6.Cells(22, 3)
Sheet1.Cells(rowxm, 39) = Sheet6.Cells(23, 3)
Sheet1.Activate '确保添加工作表处于激活状态
ActiveWorkbook.Save '将修改进行系统保存

Sheet6.Visible = False

'重新统计人数
x = 2 '数据源表中第一条记录所在的行号
Dim counts As Integer
counts = 0
Do While Sheet1.Cells(x, 2) <> "" '当遇到空行时结束
counts = counts + 1
x = x + 1
Loop
Sheet4.Cells(5, 5) = counts '将总的记录数保存到指定单元格

Sheet4.Activate
End If

End Sub

“添加或修改”取消操作

 Sub 按钮9_单击()
 
 '添加或修改的取消操作
 Sheet6.Visible = False
 Sheet4.Activate
 End Sub

“安全退出”

Sub 按钮10_单击()

'安全退出：隐藏除系统功能表外的其他工作表，并对所有工作表进行保存操作

Sheet1.Visible = False
Sheet2.Visible = False
Sheet4.Visible = False
Sheet5.Visible = False
Sheet6.Visible = False
'ActiveWorkbook.Close Savechanges:=True
ActiveWorkbook.Save
'Application.Quit

Sheet3.Activate
Range("A1").Select
login.TextBox1.Text = ""
login.TextBox2.Text = ""
login.Show

End Sub

“身份证”校验

Sub 按钮11_单击()

'校验身份证
Result = getCheckCode(Sheet6.Cells(13, 3)) '返回的值为两部分，第一个数字为错误序号，第二个数字为正确校验码
Result2 = Left(Result, 1)
Select Case Result2
Case "0": MsgBox "身份证位数错误！"
Case "1": MsgBox "身份证校验通过！"
Case "2": MsgBox "身份证错误，校验位应为：" & Right(Result, 1)
End Select
End Sub

'身份证相关的两个方法
Function getCheckCode(strSFID As String) As String

Dim sreJiaoYan As Variant
Dim intQuan As Variant
Dim strTemp As String '身份证号码前17位
Dim intTemp As Variant '保存计算出的校验位
Dim i As Integer

strJiaoYan = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
intJiaQuan = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2, 1)

If Len(strSFID) = 18 Then
strTemp = Left(strSFID, 17)
'MsgBox "输入位数正确~！"
Else
getCheckCode = "00" '输入位数不正确~！
Exit Function
End If

'求身份证号码验证位
For i = 0 To Len(strTemp) - 1
intTemp = intTemp + Mid(strTemp, i + 1, 1) * intJiaQuan(i)
Next i
'MsgBox "加权和为：" & intTemp

intTemp = intTemp Mod 11
'MsgBox "余数为：" & intTemp
intTemp = strJiaoYan(intTemp)
'MsgBox "验证位为：" & intTemp

If intTemp = Right(strSFID, 1) Then

getCheckCode = "1" & intTemp '身份证号码正确！
'Selection.Font.ColorIndex = 10
Else

getCheckCode = "2" & intTemp '身份证号码错误
End If
End Function


Function getPosition(x As Integer, y As Integer) As String
'将单元格cells(x,y)的形式表示成Range("A1")的形式
Dim A_Z As Variant
Dim pos As String
A_Z = Array("zw", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
pos = A_Z(y) & x
getPosition = pos
End Function

=========================================以下窗体login代码=========================================

*****************************************
---此模块演示了去除窗体关闭按钮---
*****************************************

Option Explicit
'以下声明API函数
#If Win64 Then '64位
Private Declare PtrSafe Function FindWindow _
Lib "User32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As LongPtr
Private Declare PtrSafe Function GetWindowLong _
Lib "User32" _
Alias "GetWindowLongPtrA" ( _
ByVal Hwnd As LongPtr, _
ByVal nIndex As Long) _
As LongPtr
Private Declare PtrSafe Function SetWindowLong _
Lib "User32" _
Alias "SetWindowLongPtrA" ( _
ByVal Hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) _
As LongPtr
Private Declare PtrSafe Function DrawMenuBar _
Lib "User32" _
( _
ByVal Hwnd As LongPtr) _
As Long
#Else '32位
'查找窗口
Private Declare Function FindWindow _
Lib "User32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) _
As Long
'取得窗口样式位
Private Declare Function GetWindowLong _
Lib "User32" _
Alias "GetWindowLongA" ( _
ByVal Hwnd As Long, _
ByVal nIndex As Long) _
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 Declare Function DrawMenuBar _
Lib "User32" ( _
ByVal Hwnd As Long) _
As Long
#End If
#If Win64 Then '64位
Private FHwnd As LongPtr
Private FIstype As LongPtr
#Else
Private FHwnd As Long
Private FIstype As Long
#End If
'以下定义常数
Private Const GWL_STYLE = (-16) '窗口样式
Private Const WS_SYSMENU = &H80000 '系统菜单

验证登录
Private Sub CommandButton1_Click()
'系统保存的账户和密码
'Sheet1.Activate
'用户输入的账户和密码
Dim uname As String
Dim upass As String
Dim zh As String
Dim mm As String

uname = Trim(login.TextBox1.Text)
upass = Trim(login.TextBox2.Text)

If uname = "" Or upass = "" Then
MsgBox "请输入帐号和密码！"
Exit Sub
End If

If Trim(login.CommandButton1.Caption) = "注册" And Sheet5.Cells(2, 1) = "" Then
Sheet5.Cells(2, 1) = Trim(login.TextBox1.Text)
Sheet5.Cells(2, 2) = Trim(login.TextBox2.Text)
MsgBox "注册成功，请登录！"
login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
login.CommandButton1.Caption = "登录"
login.TextBox1.Text = ""
login.TextBox2.Text = ""
Exit Sub
End If


zh = Trim(Sheet5.Cells(2, 1))
mm = Trim(Sheet5.Cells(2, 2))

If login.CommandButton1.Caption = "登录" And uname = zh And upass = mm Then

login.Hide
Sheet4.Visible = True
Sheet4.Activate
Range("C21").Select

Else
MsgBox "帐号或密码错误，请重试！"
login.TextBox1.Text = ""
login.TextBox2.Text = ""
End If
End Sub

关闭
Private Sub CommandButton2_Click()
Sheet1.Visible = False
Sheet2.Visible = False
Sheet6.Visible = False
Sheet4.Visible = False
Sheet5.Visible = False
Sheet3.Activate
Range("A1").Select
'ActiveWorkbook.Close Savechanges:=True
ActiveWorkbook.Save
Application.Quit
End Sub

忘记密码

Private Sub CommandButton3_Click()

Sheet5.Cells(2, 3) = Sheet5.Cells(2, 3) + 1
login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
If Sheet5.Cells(2, 3) > 5 Then
login.CommandButton1.Enabled = False
MsgBox "您的记性太差，系统将不再提供给您使用！"
Exit Sub
End If

Sheet5.Cells(2, 1) = ""
Sheet5.Cells(2, 2) = ""

login.CommandButton1.Caption = "注册"
MsgBox "请重新注册帐号！"
End Sub

Private Sub UserForm_Activate()
If Sheet5.Cells(2, 1) <> "" Then
login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
login.CommandButton1.Caption = "登录"
End If
End Sub

*****************************************
-------------------主程序--------------------
*****************************************

Private Sub UserForm_Initialize()
'查找窗口句柄
FHwnd = FindWindow("ThunderDFrame", Me.Caption)
'取得窗口样式位
FIstype = GetWindowLong(FHwnd, GWL_STYLE)
'窗体样式位: 原样式和无系统菜单
FIstype = FIstype And Not WS_SYSMENU
'重设窗体样式位
SetWindowLong FHwnd, GWL_STYLE, FIstype
'重绘窗体标题栏
DrawMenuBar FHwnd

End Sub

Tony.Zhou

关注

6
点赞
踩
18

收藏

觉得还不错? 一键收藏
1
评论
[VBA]Excel 人员信息管理

系统截图：登录窗体加载代码： Sub Auto_Open() '自动加载窗体 login.Show End Sub“统计”按钮Sub 按钮1_单击() '查看总记录数 x = 2 '数据源表中第一条记录所在的行号 Dim counts As Integer counts = 0 Do While Sheet1.Cells(x, 2) &l...
复制链接

扫一扫