Excel VBA 人员信息管理

系统截图：

      

 

登录窗体加载代码：

1 Sub Auto_Open()
2   '自动加载窗体
3   login.Show
4   End Sub

 

“统计”按钮

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

 

打印所选人员信息

  1 Sub 按钮2_单击()
  2 
  3 '执行打印选择人员基本信息
  4 
  5 
  6 xm = Sheet4.Cells(7, 5) '从 系统功能表 中获取选择的姓名
  7 
  8 If xm = "" Then '如果未选择，则提示选择
  9 MsgBox "请选择人员！"
 10 End If
 11 
 12 '从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
 13 rowxm = 0 '初始值为0
 14 i = 2
 15 Do While Not IsEmpty(Sheet1.Cells(i, 2))
 16 
 17 If xm = Sheet1.Cells(i, 2) Then
 18 rowxm = i
 19 'MsgBox "所在行号为:" + Trim(Str(i))
 20 Exit Do
 21 End If
 22 i = i + 1
 23 Loop
 24 
 25 
 26 If rowxm <> 0 Then
 27 '打印提示信息,flag2的值有两个:1表示打印,2表示不打印
 28 flag2 = MsgBox("您将打印" & xm & "的基本信息！", 1)
 29 
 30 If flag2 = 1 Then
 31 
 32 Sheet2.Visible = True
 33 Sheet2.Activate
 34 
 35 
 36 '将 基本数据表 中的相关信息填充到 打印 表中的相应位置
 37 Sheet2.Cells(2, 2) = Sheet1.Cells(rowxm, 1) '单位
 38 Sheet2.Cells(3, 2) = Sheet1.Cells(rowxm, 2) '姓名
 39 Sheet2.Cells(3, 5) = Sheet1.Cells(rowxm, 3) '性别
 40 Sheet2.Cells(4, 2) = Sheet1.Cells(rowxm, 4) '民族
 41 Sheet2.Cells(4, 4) = Sheet1.Cells(rowxm, 5) '政治面貌
 42 Sheet2.Cells(5, 2) = Sheet1.Cells(rowxm, 6) '出生日期
 43 Sheet2.Cells(5, 4) = Sheet1.Cells(rowxm, 7) '出生地
 44 Sheet2.Cells(6, 2) = Sheet1.Cells(rowxm, 8) '毕业学校
 45 Sheet2.Cells(7, 2) = Sheet1.Cells(rowxm, 9) '所学专业
 46 Sheet2.Cells(8, 2) = Sheet1.Cells(rowxm, 10) '学位
 47 Sheet2.Cells(8, 7) = Sheet1.Cells(rowxm, 11) '学历
 48 Sheet2.Cells(9, 2) = Sheet1.Cells(rowxm, 12) '现职业
 49 Sheet2.Cells(9, 7) = Sheet1.Cells(rowxm, 13) '职务
 50 Sheet2.Cells(10, 2) = Sheet1.Cells(rowxm, 14) '地址
 51 Sheet2.Cells(10, 8) = Sheet1.Cells(rowxm, 15) '邮编
 52 Sheet2.Cells(11, 2) = Sheet1.Cells(rowxm, 16) '电话
 53 Sheet2.Cells(11, 7) = Sheet1.Cells(rowxm, 17) '邮箱
 54 Sheet2.Cells(12, 3) = Sheet1.Cells(rowxm, 18) '学科
 55 Sheet2.Cells(13, 3) = Sheet1.Cells(rowxm, 19) '身份证
 56 Sheet2.Cells(16, 1) = Sheet1.Cells(rowxm, 20)
 57 Sheet2.Cells(16, 7) = Sheet1.Cells(rowxm, 21)
 58 Sheet2.Cells(16, 3) = Sheet1.Cells(rowxm, 22)
 59 Sheet2.Cells(16, 8) = Sheet1.Cells(rowxm, 23)
 60 Sheet2.Cells(17, 1) = Sheet1.Cells(rowxm, 24)
 61 Sheet2.Cells(17, 7) = Sheet1.Cells(rowxm, 25)
 62 Sheet2.Cells(17, 3) = Sheet1.Cells(rowxm, 26)
 63 Sheet2.Cells(17, 8) = Sheet1.Cells(rowxm, 27)
 64 Sheet2.Cells(18, 1) = Sheet1.Cells(rowxm, 28)
 65 Sheet2.Cells(18, 7) = Sheet1.Cells(rowxm, 29)
 66 Sheet2.Cells(18, 3) = Sheet1.Cells(rowxm, 30)
 67 Sheet2.Cells(18, 8) = Sheet1.Cells(rowxm, 31)
 68 Sheet2.Cells(19, 1) = Sheet1.Cells(rowxm, 32)
 69 Sheet2.Cells(19, 7) = Sheet1.Cells(rowxm, 33)
 70 Sheet2.Cells(19, 3) = Sheet1.Cells(rowxm, 34)
 71 Sheet2.Cells(19, 8) = Sheet1.Cells(rowxm, 35)
 72 Sheet2.Cells(20, 3) = Sheet1.Cells(rowxm, 36)
 73 Sheet2.Cells(21, 3) = Sheet1.Cells(rowxm, 37)
 74 Sheet2.Cells(22, 3) = Sheet1.Cells(rowxm, 38)
 75 Sheet2.Cells(23, 3) = Sheet1.Cells(rowxm, 39)
 76 Sheet2.Cells(3, 8) = ""
 77 '照片处理
 78 ActiveSheet.Pictures.Delete '删除之前的照片
 79 Dim MyFile As Object
 80 Set MyFile = CreateObject("Scripting.FileSystemObject")
 81 If MyFile.FileExists(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg") = True Then
 82 ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
 83 Else
 84 ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\shili.jpg").Select
 85 End If
 86 With Selection
 87 .Top = Range("H3:H7").Top + 2
 88 .Left = Range("H3:H7").Left + 3
 89 
 90 .Height = Range("H3:H7").Height - 4
 91 .Width = Range("H3:H7").Width - 4
 92 End With
 93 
 94 
 95 Range("A1:H23").Select
 96 ActiveWindow.SelectedSheets.PrintPreview '打印预览
 97 'Selection.PrintOut Copies:=1, Collate:=True
 98 
 99 Sheet2.Visible = False
100 Sheet4.Activate
101 
102 Else
103 MsgBox "您已取消打印~！"
104 End If 'flag2判断是否打印 结束
105 End If '选择的姓名存在对应的行号
106 
107 Sheet4.Cells(7, 5) = Sheet1.Cells(2, 2)
108 End Sub

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

 1 Sub 按钮3_单击()
 2 
 3 '修改一人---视图
 4 
 5 xm = Sheet4.Cells(9, 5) '从 系统功能表 中获取选择的姓名
 6 If xm = "" Then '如果未选择，则提示选择
 7 MsgBox "请选择人员！"
 8 End If
 9 
10 '从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
11 rowxm = 0 '初始值为0
12 i = 2
13 Do While Not IsEmpty(Sheet1.Cells(i, 2))
14 
15 If xm = Sheet1.Cells(i, 2) Then
16 rowxm = i
17 'MsgBox "所在行号为:" + Trim(Str(i))
18 Exit Do
19 End If
20 i = i + 1
21 Loop
22 
23 
24 If rowxm <> 0 Then '找到之后
25 
26 Sheet6.Visible = True
27 Sheet6.Activate
28 
29 
30 '将 基本数据表 中的相关信息填充到 打印 表中的相应位置
31 Sheet6.Cells(2, 2) = Sheet1.Cells(rowxm, 1) '单位
32 Sheet6.Cells(3, 2) = Sheet1.Cells(rowxm, 2) '姓名
33 Sheet6.Cells(3, 5) = Sheet1.Cells(rowxm, 3) '性别
34 Sheet6.Cells(4, 2) = Sheet1.Cells(rowxm, 4) '民族
35 Sheet6.Cells(4, 4) = Sheet1.Cells(rowxm, 5) '政治面貌
36 Sheet6.Cells(5, 2) = Sheet1.Cells(rowxm, 6) '出生日期
37 Sheet6.Cells(5, 4) = Sheet1.Cells(rowxm, 7) '出生地
38 Sheet6.Cells(6, 2) = Sheet1.Cells(rowxm, 8) '毕业学校
39 Sheet6.Cells(7, 2) = Sheet1.Cells(rowxm, 9) '所学专业
40 Sheet6.Cells(8, 2) = Sheet1.Cells(rowxm, 10) '学位
41 Sheet6.Cells(8, 7) = Sheet1.Cells(rowxm, 11) '学历
42 Sheet6.Cells(9, 2) = Sheet1.Cells(rowxm, 12) '现职业
43 Sheet6.Cells(9, 7) = Sheet1.Cells(rowxm, 13) '职务
44 Sheet6.Cells(10, 2) = Sheet1.Cells(rowxm, 14) '地址
45 Sheet6.Cells(10, 8) = Sheet1.Cells(rowxm, 15) '邮编
46 Sheet6.Cells(11, 2) = Sheet1.Cells(rowxm, 16) '电话
47 Sheet6.Cells(11, 7) = Sheet1.Cells(rowxm, 17) '邮箱
48 Sheet6.Cells(12, 3) = Sheet1.Cells(rowxm, 18) '学科
49 Sheet6.Cells(13, 3) = Sheet1.Cells(rowxm, 19) '身份证
50 Sheet6.Cells(16, 1) = Sheet1.Cells(rowxm, 20)
51 Sheet6.Cells(16, 7) = Sheet1.Cells(rowxm, 21)
52 Sheet6.Cells(16, 3) = Sheet1.Cells(rowxm, 22)
53 Sheet6.Cells(16, 8) = Sheet1.Cells(rowxm, 23)
54 Sheet6.Cells(17, 1) = Sheet1.Cells(rowxm, 24)
55 Sheet6.Cells(17, 7) = Sheet1.Cells(rowxm, 25)
56 Sheet6.Cells(17, 3) = Sheet1.Cells(rowxm, 26)
57 Sheet6.Cells(17, 8) = Sheet1.Cells(rowxm, 27)
58 Sheet6.Cells(18, 1) = Sheet1.Cells(rowxm, 28)
59 Sheet6.Cells(18, 7) = Sheet1.Cells(rowxm, 29)
60 Sheet6.Cells(18, 3) = Sheet1.Cells(rowxm, 30)
61 Sheet6.Cells(18, 8) = Sheet1.Cells(rowxm, 31)
62 Sheet6.Cells(19, 1) = Sheet1.Cells(rowxm, 32)
63 Sheet6.Cells(19, 7) = Sheet1.Cells(rowxm, 33)
64 Sheet6.Cells(19, 3) = Sheet1.Cells(rowxm, 34)
65 Sheet6.Cells(19, 8) = Sheet1.Cells(rowxm, 35)
66 Sheet6.Cells(20, 3) = Sheet1.Cells(rowxm, 36)
67 Sheet6.Cells(21, 3) = Sheet1.Cells(rowxm, 37)
68 Sheet6.Cells(22, 3) = Sheet1.Cells(rowxm, 38)
69 Sheet6.Cells(23, 3) = Sheet1.Cells(rowxm, 39)
70 
71 
72 End If '选择的姓名存在对应的行号
73 Sheet4.Cells(9, 5) = Sheet1.Cells(2, 2)
74 End Sub

 

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

 1 Sub 按钮3_1_单击()
 2 
 3 '修改一人---提交修改
 4 
 5 Sheet6.Activate
 6 ActiveWorkbook.Save '将修改进行系统保存
 7 xm = Sheet6.Cells(3, 2)
 8 '从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
 9 rowxm = 0 '初始值为0
10 i = 2
11 Do While Not IsEmpty(Sheet1.Cells(i, 2))
12 
13 If xm = Sheet1.Cells(i, 2) Then
14 rowxm = i
15 'MsgBox "所在行号为:" + Trim(Str(i))
16 Exit Do
17 End If
18 i = i + 1
19 Loop
20 
21 If rowxm <> 0 Then '找到之后，写到基本数据表相应行中
22 
23 '将 基本数据表 中的相关信息填充到 打印 表中的相应位置
24 Sheet1.Cells(rowxm, 1) = Sheet6.Cells(2, 2) '单位
25 'Sheet1.Cells(rowxm, 2) = Sheet6.Cells(3, 2) '姓名不改变
26 Sheet1.Cells(rowxm, 3) = Sheet6.Cells(3, 5) '性别
27 Sheet1.Cells(rowxm, 4) = Sheet6.Cells(4, 2)
28 Sheet1.Cells(rowxm, 5) = Sheet6.Cells(4, 4)
29 Sheet1.Cells(rowxm, 6) = Sheet6.Cells(5, 2)
30 Sheet1.Cells(rowxm, 7) = Sheet6.Cells(5, 4)
31 Sheet1.Cells(rowxm, 8) = Sheet6.Cells(6, 2)
32 Sheet1.Cells(rowxm, 9) = Sheet6.Cells(7, 2)
33 Sheet1.Cells(rowxm, 10) = Sheet6.Cells(8, 2)
34 Sheet1.Cells(rowxm, 11) = Sheet6.Cells(8, 7)
35 Sheet1.Cells(rowxm, 12) = Sheet6.Cells(9, 2)
36 Sheet1.Cells(rowxm, 13) = Sheet6.Cells(9, 7)
37 Sheet1.Cells(rowxm, 14) = Sheet6.Cells(10, 2)
38 Sheet1.Cells(rowxm, 15) = Sheet6.Cells(10, 8)
39 Sheet1.Cells(rowxm, 16) = Sheet6.Cells(11, 2)
40 Sheet1.Cells(rowxm, 17) = Sheet6.Cells(11, 7)
41 Sheet1.Cells(rowxm, 18) = Sheet6.Cells(12, 3)
42 Sheet1.Cells(rowxm, 19) = Sheet6.Cells(13, 3)
43 Sheet1.Cells(rowxm, 20) = Sheet6.Cells(16, 1)
44 Sheet1.Cells(rowxm, 21) = Sheet6.Cells(16, 7)
45 Sheet1.Cells(rowxm, 22) = Sheet6.Cells(16, 3)
46 Sheet1.Cells(rowxm, 23) = Sheet6.Cells(16, 8)
47 Sheet1.Cells(rowxm, 24) = Sheet6.Cells(17, 1)
48 Sheet1.Cells(rowxm, 25) = Sheet6.Cells(17, 7)
49 Sheet1.Cells(rowxm, 26) = Sheet6.Cells(17, 3)
50 Sheet1.Cells(rowxm, 27) = Sheet6.Cells(17, 8)
51 Sheet1.Cells(rowxm, 28) = Sheet6.Cells(18, 1)
52 Sheet1.Cells(rowxm, 29) = Sheet6.Cells(18, 7)
53 Sheet1.Cells(rowxm, 30) = Sheet6.Cells(18, 3)
54 Sheet1.Cells(rowxm, 31) = Sheet6.Cells(18, 8)
55 Sheet1.Cells(rowxm, 32) = Sheet6.Cells(19, 1)
56 Sheet1.Cells(rowxm, 33) = Sheet6.Cells(19, 7)
57 Sheet1.Cells(rowxm, 34) = Sheet6.Cells(19, 3)
58 Sheet1.Cells(rowxm, 35) = Sheet6.Cells(19, 8)
59 Sheet1.Cells(rowxm, 36) = Sheet6.Cells(20, 3)
60 Sheet1.Cells(rowxm, 37) = Sheet6.Cells(21, 3)
61 Sheet1.Cells(rowxm, 38) = Sheet6.Cells(22, 3)
62 Sheet1.Cells(rowxm, 39) = Sheet6.Cells(23, 3)
63 
64 End If '选择的姓名存在对应的行号
65 
66 Sheet6.Visible = False
67 Sheet4.Activate
68 
69 End Sub

 

“删除”所选人员信息

 1 Sub 按钮4_单击()
 2 
 3 '删除选择人员
 4 xm = Sheet4.Cells(11, 5) '从 系统功能表 中获取选择的姓名
 5 If xm = "" Then '如果未选择，则提示选择
 6 MsgBox "请选择人员！"
 7 End If
 8 
 9 '从 基本数据表 中通过姓名查找此人所在行号,rowxm保存此人所在行的行号
10 rowxm = 0 '初始值为0
11 i = 2
12 Do While Not IsEmpty(Sheet1.Cells(i, 2))
13 
14 If xm = Sheet1.Cells(i, 2) Then
15 rowxm = i
16 'MsgBox "所在行号为:" + Trim(Str(i))
17 Exit Do
18 End If
19 i = i + 1
20 Loop
21 
22 
23 If rowxm <> 0 Then '找到之后删除
24 flag2 = MsgBox("您确定要删除" & xm & "的基本信息！", 1)
25 If flag2 = 1 Then
26 'Sheet1.Visible = True
27 Sheet1.Activate
28 Rows(rowxm & ":" & rowxm).Select
29 Selection.Delete Shift:=xlUp
30 ActiveWorkbook.Save '数据保存
31 Else
32 MsgBox ("您已取消删除！")
33 End If
34 End If '选择的姓名存在对应的行号
35 Sheet4.Cells(11, 5) = Sheet1.Cells(2, 2)
36 
37 '重新统计人数
38 x = 2 '数据源表中第一条记录所在的行号
39 Dim counts As Integer
40 counts = 0
41 Do While Sheet1.Cells(x, 2) <> "" '当遇到空行时结束
42 counts = counts + 1
43 x = x + 1
44 Loop
45 Sheet4.Cells(5, 5) = counts '将总的记录数保存到指定单元格
46 
47 'Sheet1.Visible = False
48 Sheet4.Activate
49 End Sub

“打印所有人员信息”

 1 Sub 按钮5_单击()
 2 
 3 '执行打印所有人员信息
 4 
 5 '找到最后一条记录的行号，保存到rowxm中
 6 flag = 1 '1表示是一个新人，2表示已经存在
 7 i = 2
 8 Do While Not IsEmpty(Sheet1.Cells(i, 2))
 9 i = i + 1
10 Loop
11 rowxm = i - 1
12 
13 '打印提示信息,flag2的值有两个:1表示打印,2表示不打印
14 flag2 = MsgBox("您将打印" & (i - 2) & "名人员基本信息表！", 1)
15 
16 If flag2 = 1 Then
17 
18 Sheet2.Visible = True
19 Sheet2.Activate
20 For i = 2 To rowxm
21 On Error GoTo over '对用户打印过程中取消打印时的处理
22 '将 基本数据表 中的相关信息填充到 打印 表中的相应位置
23 Sheet2.Cells(2, 2) = Sheet1.Cells(i, 1) '单位
24 Sheet2.Cells(3, 2) = Sheet1.Cells(i, 2) '姓名
25 Sheet2.Cells(3, 5) = Sheet1.Cells(i, 3) '性别
26 Sheet2.Cells(4, 2) = Sheet1.Cells(i, 4) '民族
27 Sheet2.Cells(4, 4) = Sheet1.Cells(i, 5) '政治面貌
28 Sheet2.Cells(5, 2) = Sheet1.Cells(i, 6) '出生日期
29 Sheet2.Cells(5, 4) = Sheet1.Cells(i, 7) '出生地
30 Sheet2.Cells(6, 2) = Sheet1.Cells(i, 8) '毕业学校
31 Sheet2.Cells(7, 2) = Sheet1.Cells(i, 9) '所学专业
32 Sheet2.Cells(8, 2) = Sheet1.Cells(i, 10) '学位
33 Sheet2.Cells(8, 7) = Sheet1.Cells(i, 11) '学历
34 Sheet2.Cells(9, 2) = Sheet1.Cells(i, 12) '现职业
35 Sheet2.Cells(9, 7) = Sheet1.Cells(i, 13) '职务
36 Sheet2.Cells(10, 2) = Sheet1.Cells(i, 14) '地址
37 Sheet2.Cells(10, 8) = Sheet1.Cells(i, 15) '邮编
38 Sheet2.Cells(11, 2) = Sheet1.Cells(i, 16) '电话
39 Sheet2.Cells(11, 7) = Sheet1.Cells(i, 17) '邮箱
40 Sheet2.Cells(12, 3) = Sheet1.Cells(i, 18) '学科
41 Sheet2.Cells(13, 3) = Sheet1.Cells(i, 19) '身份证
42 Sheet2.Cells(16, 1) = Sheet1.Cells(i, 20)
43 Sheet2.Cells(16, 7) = Sheet1.Cells(i, 21)
44 Sheet2.Cells(16, 3) = Sheet1.Cells(i, 22)
45 Sheet2.Cells(16, 8) = Sheet1.Cells(i, 23)
46 Sheet2.Cells(17, 1) = Sheet1.Cells(i, 24)
47 Sheet2.Cells(17, 7) = Sheet1.Cells(i, 25)
48 Sheet2.Cells(17, 3) = Sheet1.Cells(i, 26)
49 Sheet2.Cells(17, 8) = Sheet1.Cells(i, 27)
50 Sheet2.Cells(18, 1) = Sheet1.Cells(i, 28)
51 Sheet2.Cells(18, 7) = Sheet1.Cells(i, 29)
52 Sheet2.Cells(18, 3) = Sheet1.Cells(i, 30)
53 Sheet2.Cells(18, 8) = Sheet1.Cells(i, 31)
54 Sheet2.Cells(19, 1) = Sheet1.Cells(i, 32)
55 Sheet2.Cells(19, 7) = Sheet1.Cells(i, 33)
56 Sheet2.Cells(19, 3) = Sheet1.Cells(i, 34)
57 Sheet2.Cells(19, 8) = Sheet1.Cells(i, 35)
58 Sheet2.Cells(20, 3) = Sheet1.Cells(i, 36)
59 Sheet2.Cells(21, 3) = Sheet1.Cells(i, 37)
60 Sheet2.Cells(22, 3) = Sheet1.Cells(i, 38)
61 Sheet2.Cells(23, 3) = Sheet1.Cells(i, 39)
62 Sheet2.Cells(3, 8) = ""
63 '照片处理
64 ActiveSheet.Pictures.Delete '删除之前的照片
65 Dim MyFile As Object
66 Set MyFile = CreateObject("Scripting.FileSystemObject")
67 If MyFile.FileExists(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg") = True Then
68 ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
69 Else
70 ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\shili.jpg").Select
71 End If
72 
73 'ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\照片\" & Sheet2.Cells(13, 3) & ".jpg").Select
74 With Selection
75 .Top = Range("H3:H7").Top
76 .Left = Range("H3:H7").Left
77 
78 .Height = Range("H3:H7").Height
79 .Width = Range("H3:H7").Width
80 End With
81 
82 Range("A1:H23").Select
83 Selection.PrintOut Copies:=1, Collate:=True
84 
85 Next
86 over: '对用户打印过程中取消打印时的处理
87 Sheet2.Visible = False
88 Sheet4.Activate
89 
90 
91 Else
92 MsgBox "您已取消打印~！"
93 End If 'flag2判断是否打印 结束
94 
95 End Sub

“查看基本表”信息

 1 Sub 按钮6_单击()
 2 
 3 '查看基本数据表
 4 '密码验证
 5 Dim mm As String
 6 
 7 mm = InputBox("请输入系统登录密码：", 信息查看前验证, "")
 8 If mm = "" Then
 9 MsgBox "请输入系统登录密码，通过后方可查看！"
10 Exit Sub
11 End If
12 If mm <> Sheet5.Cells(2, 2) Then
13 MsgBox "密码错误！"
14 Exit Sub
15 End If
16 
17 If mm = Sheet5.Cells(2, 2) Then
18 Sheet1.Visible = True
19 Sheet1.Activate
20 End If
21 
22 End Sub

 

“隐藏”基本数据表

1 Sub 按钮7_单击()
2 
3 '隐藏基本数据表
4 
5 Sheet1.Visible = False
6 Sheet4.Activate
7 
8 End Sub

“添加一人”视图

 1 Sub 按钮8_单击()
 2 
 3 '添加一人---视图
 4 Sheet6.Visible = True
 5 Sheet6.Activate
 6 '清空添加表中输入的数据
 7 Sheet6.Cells(2, 2) = ""
 8 Sheet6.Cells(3, 2) = ""
 9 Sheet6.Cells(3, 5) = ""
10 Sheet6.Cells(4, 2) = ""
11 Sheet6.Cells(4, 4) = ""
12 Sheet6.Cells(5, 2) = ""
13 Sheet6.Cells(5, 4) = ""
14 Sheet6.Cells(6, 2) = ""
15 Sheet6.Cells(7, 2) = ""
16 Sheet6.Cells(8, 2) = ""
17 Sheet6.Cells(8, 7) = ""
18 Sheet6.Cells(9, 2) = ""
19 Sheet6.Cells(9, 7) = ""
20 Sheet6.Cells(10, 2) = ""
21 Sheet6.Cells(10, 8) = ""
22 Sheet6.Cells(11, 2) = ""
23 Sheet6.Cells(11, 7) = ""
24 Sheet6.Cells(12, 3) = ""
25 Sheet6.Cells(13, 3) = ""
26 Sheet6.Cells(16, 1) = ""
27 Sheet6.Cells(16, 7) = ""
28 Sheet6.Cells(16, 3) = ""
29 Sheet6.Cells(16, 8) = ""
30 Sheet6.Cells(17, 1) = ""
31 Sheet6.Cells(17, 7) = ""
32 Sheet6.Cells(17, 3) = ""
33 Sheet6.Cells(17, 8) = ""
34 Sheet6.Cells(18, 1) = ""
35 Sheet6.Cells(18, 7) = ""
36 Sheet6.Cells(18, 3) = ""
37 Sheet6.Cells(18, 8) = ""
38 Sheet6.Cells(19, 1) = ""
39 Sheet6.Cells(19, 7) = ""
40 Sheet6.Cells(19, 3) = ""
41 Sheet6.Cells(19, 8) = ""
42 Sheet6.Cells(20, 3) = ""
43 Sheet6.Cells(21, 3) = ""
44 Sheet6.Cells(22, 3) = ""
45 Sheet6.Cells(23, 3) = ""
46 
47 End Sub

“添加一人”处理：

 1 Sub 按钮8_1_单击()
 2 
 3 '添加一人---提交添加
 4 
 5 Sheet6.Activate '确保添加工作表处于激活状态
 6 ActiveWorkbook.Save '将 添加工作表 进行系统保存
 7 
 8 xm = Sheet6.Cells(3, 2) '检查该人员是否已经存在
 9 
10 '找到第一个出现的空行的行号，保存到rowxm中
11 flag = 1 '1表示是一个新人，2表示已经存在
12 i = 2
13 Do While Not IsEmpty(Sheet1.Cells(i, 2))
14 If xm = Sheet1.Cells(i, 2) Then
15 flag = 2
16 MsgBox "该人员已经存在,请修改后重新添加！"
17 Exit Do
18 End If
19 i = i + 1
20 Loop
21 rowxm = i
22 
23 If flag = 1 Then '是新人员，'将输入的基本信息保存到 基本数据表 中
24 
25 
26 Sheet1.Cells(rowxm, 1) = Sheet6.Cells(2, 2) '单位
27 Sheet1.Cells(rowxm, 2) = Sheet6.Cells(3, 2) '姓名不改变
28 Sheet1.Cells(rowxm, 3) = Sheet6.Cells(3, 5) '性别
29 Sheet1.Cells(rowxm, 4) = Sheet6.Cells(4, 2)
30 Sheet1.Cells(rowxm, 5) = Sheet6.Cells(4, 4)
31 Sheet1.Cells(rowxm, 6) = Sheet6.Cells(5, 2)
32 Sheet1.Cells(rowxm, 7) = Sheet6.Cells(5, 4)
33 Sheet1.Cells(rowxm, 8) = Sheet6.Cells(6, 2)
34 Sheet1.Cells(rowxm, 9) = Sheet6.Cells(7, 2)
35 Sheet1.Cells(rowxm, 10) = Sheet6.Cells(8, 2)
36 Sheet1.Cells(rowxm, 11) = Sheet6.Cells(8, 7)
37 Sheet1.Cells(rowxm, 12) = Sheet6.Cells(9, 2)
38 Sheet1.Cells(rowxm, 13) = Sheet6.Cells(9, 7)
39 Sheet1.Cells(rowxm, 14) = Sheet6.Cells(10, 2)
40 Sheet1.Cells(rowxm, 15) = Sheet6.Cells(10, 8)
41 Sheet1.Cells(rowxm, 16) = Sheet6.Cells(11, 2)
42 Sheet1.Cells(rowxm, 17) = Sheet6.Cells(11, 7)
43 Sheet1.Cells(rowxm, 18) = Sheet6.Cells(12, 3)
44 Sheet1.Cells(rowxm, 19) = Sheet6.Cells(13, 3)
45 Sheet1.Cells(rowxm, 20) = Sheet6.Cells(16, 1)
46 Sheet1.Cells(rowxm, 21) = Sheet6.Cells(16, 7)
47 Sheet1.Cells(rowxm, 22) = Sheet6.Cells(16, 3)
48 Sheet1.Cells(rowxm, 23) = Sheet6.Cells(16, 8)
49 Sheet1.Cells(rowxm, 24) = Sheet6.Cells(17, 1)
50 Sheet1.Cells(rowxm, 25) = Sheet6.Cells(17, 7)
51 Sheet1.Cells(rowxm, 26) = Sheet6.Cells(17, 3)
52 Sheet1.Cells(rowxm, 27) = Sheet6.Cells(17, 8)
53 Sheet1.Cells(rowxm, 28) = Sheet6.Cells(18, 1)
54 Sheet1.Cells(rowxm, 29) = Sheet6.Cells(18, 7)
55 Sheet1.Cells(rowxm, 30) = Sheet6.Cells(18, 3)
56 Sheet1.Cells(rowxm, 31) = Sheet6.Cells(18, 8)
57 Sheet1.Cells(rowxm, 32) = Sheet6.Cells(19, 1)
58 Sheet1.Cells(rowxm, 33) = Sheet6.Cells(19, 7)
59 Sheet1.Cells(rowxm, 34) = Sheet6.Cells(19, 3)
60 Sheet1.Cells(rowxm, 35) = Sheet6.Cells(19, 8)
61 Sheet1.Cells(rowxm, 36) = Sheet6.Cells(20, 3)
62 Sheet1.Cells(rowxm, 37) = Sheet6.Cells(21, 3)
63 Sheet1.Cells(rowxm, 38) = Sheet6.Cells(22, 3)
64 Sheet1.Cells(rowxm, 39) = Sheet6.Cells(23, 3)
65 Sheet1.Activate '确保添加工作表处于激活状态
66 ActiveWorkbook.Save '将修改进行系统保存
67 
68 Sheet6.Visible = False
69 
70 '重新统计人数
71 x = 2 '数据源表中第一条记录所在的行号
72 Dim counts As Integer
73 counts = 0
74 Do While Sheet1.Cells(x, 2) <> "" '当遇到空行时结束
75 counts = counts + 1
76 x = x + 1
77 Loop
78 Sheet4.Cells(5, 5) = counts '将总的记录数保存到指定单元格
79 
80 Sheet4.Activate
81 End If
82 
83 End Sub

“添加或修改”取消操作

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

“安全退出”

 1 Sub 按钮10_单击()
 2 
 3 '安全退出：隐藏除系统功能表外的其他工作表，并对所有工作表进行保存操作
 4 
 5 Sheet1.Visible = False
 6 Sheet2.Visible = False
 7 Sheet4.Visible = False
 8 Sheet5.Visible = False
 9 Sheet6.Visible = False
10 'ActiveWorkbook.Close Savechanges:=True
11 ActiveWorkbook.Save
12 'Application.Quit
13 
14 Sheet3.Activate
15 Range("A1").Select
16 login.TextBox1.Text = ""
17 login.TextBox2.Text = ""
18 login.Show
19 
20 End Sub

“身份证”校验

 1 Sub 按钮11_单击()
 2 
 3 '校验身份证
 4 Result = getCheckCode(Sheet6.Cells(13, 3)) '返回的值为两部分，第一个数字为错误序号，第二个数字为正确校验码
 5 Result2 = Left(Result, 1)
 6 Select Case Result2
 7 Case "0": MsgBox "身份证位数错误！"
 8 Case "1": MsgBox "身份证校验通过！"
 9 Case "2": MsgBox "身份证错误，校验位应为：" & Right(Result, 1)
10 End Select
11 End Sub
12 
13 '身份证相关的两个方法
14 Function getCheckCode(strSFID As String) As String
15 
16 Dim sreJiaoYan As Variant
17 Dim intQuan As Variant
18 Dim strTemp As String '身份证号码前17位
19 Dim intTemp As Variant '保存计算出的校验位
20 Dim i As Integer
21 
22 strJiaoYan = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
23 intJiaQuan = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2, 1)
24 
25 If Len(strSFID) = 18 Then
26 strTemp = Left(strSFID, 17)
27 'MsgBox "输入位数正确~！"
28 Else
29 getCheckCode = "00" '输入位数不正确~！
30 Exit Function
31 End If
32 
33 '求身份证号码验证位
34 For i = 0 To Len(strTemp) - 1
35 intTemp = intTemp + Mid(strTemp, i + 1, 1) * intJiaQuan(i)
36 Next i
37 'MsgBox "加权和为：" & intTemp
38 
39 intTemp = intTemp Mod 11
40 'MsgBox "余数为：" & intTemp
41 intTemp = strJiaoYan(intTemp)
42 'MsgBox "验证位为：" & intTemp
43 
44 If intTemp = Right(strSFID, 1) Then
45 
46 getCheckCode = "1" & intTemp '身份证号码正确！
47 'Selection.Font.ColorIndex = 10
48 Else
49 
50 getCheckCode = "2" & intTemp '身份证号码错误
51 End If
52 End Function
53 
54 
55 Function getPosition(x As Integer, y As Integer) As String
56 '将单元格cells(x,y)的形式表示成Range("A1")的形式
57 Dim A_Z As Variant
58 Dim pos As String
59 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")
60 pos = A_Z(y) & x
61 getPosition = pos
62 End Function

 

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

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

  1 Option Explicit
  2 '以下声明API函数
  3 #If Win64 Then '64位
  4 Private Declare PtrSafe Function FindWindow _
  5 Lib "User32" _
  6 Alias "FindWindowA" ( _
  7 ByVal lpClassName As String, _
  8 ByVal lpWindowName As String) _
  9 As LongPtr
 10 Private Declare PtrSafe Function GetWindowLong _
 11 Lib "User32" _
 12 Alias "GetWindowLongPtrA" ( _
 13 ByVal Hwnd As LongPtr, _
 14 ByVal nIndex As Long) _
 15 As LongPtr
 16 Private Declare PtrSafe Function SetWindowLong _
 17 Lib "User32" _
 18 Alias "SetWindowLongPtrA" ( _
 19 ByVal Hwnd As LongPtr, _
 20 ByVal nIndex As Long, _
 21 ByVal dwNewLong As LongPtr) _
 22 As LongPtr
 23 Private Declare PtrSafe Function DrawMenuBar _
 24 Lib "User32" _
 25 ( _
 26 ByVal Hwnd As LongPtr) _
 27 As Long
 28 #Else '32位
 29 '查找窗口
 30 Private Declare Function FindWindow _
 31 Lib "User32" _
 32 Alias "FindWindowA" ( _
 33 ByVal lpClassName As String, _
 34 ByVal lpWindowName As String) _
 35 As Long
 36 '取得窗口样式位
 37 Private Declare Function GetWindowLong _
 38 Lib "User32" _
 39 Alias "GetWindowLongA" ( _
 40 ByVal Hwnd As Long, _
 41 ByVal nIndex As Long) _
 42 As Long
 43 '设置窗口样式位
 44 Private Declare Function SetWindowLong _
 45 Lib "User32" _
 46 Alias "SetWindowLongA" ( _
 47 ByVal Hwnd As Long, _
 48 ByVal nIndex As Long, _
 49 ByVal dwNewLong As Long) _
 50 As Long
 51 '重绘窗体标题栏
 52 Private Declare Function DrawMenuBar _
 53 Lib "User32" ( _
 54 ByVal Hwnd As Long) _
 55 As Long
 56 #End If
 57 #If Win64 Then '64位
 58 Private FHwnd As LongPtr
 59 Private FIstype As LongPtr
 60 #Else
 61 Private FHwnd As Long
 62 Private FIstype As Long
 63 #End If
 64 '以下定义常数
 65 Private Const GWL_STYLE = (-16) '窗口样式
 66 Private Const WS_SYSMENU = &H80000 '系统菜单

验证登录

 68 Private Sub CommandButton1_Click()
 69 '系统保存的账户和密码
 70 'Sheet1.Activate
 71 '用户输入的账户和密码
 72 Dim uname As String
 73 Dim upass As String
 74 Dim zh As String
 75 Dim mm As String
 76 
 77 uname = Trim(login.TextBox1.Text)
 78 upass = Trim(login.TextBox2.Text)
 79 
 80 If uname = "" Or upass = "" Then
 81 MsgBox "请输入帐号和密码！"
 82 Exit Sub
 83 End If
 84 
 85 If Trim(login.CommandButton1.Caption) = "注册" And Sheet5.Cells(2, 1) = "" Then
 86 Sheet5.Cells(2, 1) = Trim(login.TextBox1.Text)
 87 Sheet5.Cells(2, 2) = Trim(login.TextBox2.Text)
 88 MsgBox "注册成功，请登录！"
 89 login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
 90 login.CommandButton1.Caption = "登录"
 91 login.TextBox1.Text = ""
 92 login.TextBox2.Text = ""
 93 Exit Sub
 94 End If
 95 
 96 
 97 zh = Trim(Sheet5.Cells(2, 1))
 98 mm = Trim(Sheet5.Cells(2, 2))
 99 
100 If login.CommandButton1.Caption = "登录" And uname = zh And upass = mm Then
101 
102 login.Hide
103 Sheet4.Visible = True
104 Sheet4.Activate
105 Range("C21").Select
106 
107 Else
108 MsgBox "帐号或密码错误，请重试！"
109 login.TextBox1.Text = ""
110 login.TextBox2.Text = ""
111 End If
112 End Sub

关闭

114 Private Sub CommandButton2_Click()
115 Sheet1.Visible = False
116 Sheet2.Visible = False
117 Sheet6.Visible = False
118 Sheet4.Visible = False
119 Sheet5.Visible = False
120 Sheet3.Activate
121 Range("A1").Select
122 'ActiveWorkbook.Close Savechanges:=True
123 ActiveWorkbook.Save
124 Application.Quit
125 End Sub

 忘记密码

 1 Private Sub CommandButton3_Click()
 2 
 3 Sheet5.Cells(2, 3) = Sheet5.Cells(2, 3) + 1
 4 login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
 5 If Sheet5.Cells(2, 3) > 5 Then
 6 login.CommandButton1.Enabled = False
 7 MsgBox "您的记性太差，系统将不再提供给您使用！"
 8 Exit Sub
 9 End If
10 
11 Sheet5.Cells(2, 1) = ""
12 Sheet5.Cells(2, 2) = ""
13 
14 login.CommandButton1.Caption = "注册"
15 MsgBox "请重新注册帐号！"
16 End Sub
17 
18 Private Sub UserForm_Activate()
19 If Sheet5.Cells(2, 1) <> "" Then
20 login.Label5.Caption = "剩余次数：" & (5 - Sheet5.Cells(2, 3))
21 login.CommandButton1.Caption = "登录"
22 End If
23 End Sub

 

 


**************************************

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

 1 Private Sub UserForm_Initialize()
 2 '查找窗口句柄
 3 FHwnd = FindWindow("ThunderDFrame", Me.Caption)
 4 '取得窗口样式位
 5 FIstype = GetWindowLong(FHwnd, GWL_STYLE)
 6 '窗体样式位: 原样式和无系统菜单
 7 FIstype = FIstype And Not WS_SYSMENU
 8 '重设窗体样式位
 9 SetWindowLong FHwnd, GWL_STYLE, FIstype
10 '重绘窗体标题栏
11 DrawMenuBar FHwnd
12 
13 End Sub
posted @ 2016-04-07 09:54  xiaohan2016  阅读(4675)  评论(0)  编辑  收藏  举报