VBA常用技巧代码解析

san158

继续发帖，库存管理

san158

工资管理软件

karana1025

非常受用！

zjy58

好东西,谢谢.

liechun1983

期待第11章

yuanzhuping

技巧197         收据系统
       开具收据是财务工作中的一项经常性的工作，如果需要开具大量收据，采用手工方法开具收据时不仅繁琐而且极易出错，此时除了使用专业软件，还可以使用VBA制作的收据填写、打印系统，简化日常工作，减轻劳动强度。
       步骤1，新建工作簿，将Sheet2工作表名称重命名为“维护”，设置成如图所示的格式，用来保存收据系统使用过程中必需的信息。


       步骤2，因为收据系统是财务方面的系统，在使用时需要相应的权限，需要使用密码登陆，所以需要一个系统登陆窗体。
       在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加三个标签控件、一个文本框控件、一个组合框和两个按钮按件，在窗体的属性窗口将其Picture属性设置为合适的图片并调整好控件的大小与位置，如图所示。
      
       双击登陆窗体，在打开的代码窗口写入下面的代码：

1. #001  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
2. #002  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
   
3. #003  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
4. #004  Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
   
5. #005  Private Const GWL_STYLE = (-16)
   
6. #006  Private Const WS_SYSMENU = &H80000
   
7. #007  Private hwnd As Long
   
8. #008  Private Sub UserForm_Initialize()
   
9. #009      Dim Istype As Long
   
10. #010      Dim r As Integer
    
11. #011      Dim i As Integer
    
12. #012      hwnd = FindWindow("ThunderDFrame", Me.Caption)
    
13. #013      Istype = GetWindowLong(hwnd, GWL_STYLE)
    
14. #014      Istype = Istype And Not WS_SYSMENU
    
15. #015      SetWindowLong hwnd, GWL_STYLE, Istype
    
16. #016      DrawMenuBar hwnd
    
17. #017      r = Sheet2.Range("A65536").End(xlUp).Row
    
18. #018      For i = 2 To r
    
19. #019          Me.ComboBox1.AddItem Sheet2.Cells(i, 1).Value
    
20. #020      Next
    
21. #021      Me.Label3.Caption = Sheet2.Cells(2, 4) & "收据系统"
    
22. #022  End Sub

复制代码

代码解析：
       登陆窗体的Initialize事件过程，窗体显示时使用API函数去除窗体的关闭按钮，组合框控件显示所有的用户名。
       第1行到第7行代码，API函数声明。
       第12行到第16行代码，去除窗体的关闭按钮。请参阅技巧138 。
       第18行到第20行代码，组合框控件显示所有的用户名供用户选择。
       第21行代码，窗体标签显示使用单位的名称。
       双击窗体上的“登陆”按钮，写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim rng As Range
   
4. #004      If ComboBox1.Value = "" Then
   
5. #005          MsgBox "请选择用户!", 64, "提示"
   
6. #006          Exit Sub
   
7. #007      End If
   
8. #008      With Sheet2
   
9. #009          r = .Range("A65536").End(xlUp).Row
   
10. #010          With .Range("A2:A" & r)
    
11. #011              Set rng = .Find(What:=ComboBox1, _
    
12. #012                  After:=.Cells(.Cells.Count), _
    
13. #013                  LookIn:=xlValues, _
    
14. #014                  LookAt:=xlWhole, _
    
15. #015                  SearchOrder:=xlByRows, _
    
16. #016                  SearchDirection:=xlNext, _
    
17. #017                  MatchCase:=False)
    
18. #018              If Not rng Is Nothing And rng.Offset(0, 1) = TextBox1 Then
    
19. #019                  Sheet2.Range("C2:C" & r).ClearContents
    
20. #020                  rng.Offset(0, 2) = "√"
    
21. #021                  Unload Me
    
22. #022                  主界面.Show
    
23. #023              Else
    
24. #024                  MsgBox "对不起,密码不正确,你无权进入!", 64, "提示"
    
25. #025                  TextBox1 = ""
    
26. #026                  TextBox1.SetFocus
    
27. #027              End If
    
28. #028          End With
    
29. #029      End With
    
30. #030  End Sub

复制代码

代码解析：
       “登陆”按钮的单击事件过程，在用户选择用户名和输入正确密码后显示“主界面”操作窗体。
       第4行到第7行代码，判断是否选择了用户名。第一次使用时默认的用户名为“系统管理员”，登陆后可以自行添加其他用户。
       第10行到第17行代码，根据所选择的用户名在“维护”工作表的A列中查找对应的用户名所在的单元格。
       第18行到第27行代码，找到后判断该用户名的密码是否与文本框中输入的密码一致。如果一致则关闭登陆窗体显示“主界面”操作窗体，否则提示用户密码错误。
       双击窗体上的“取消”按钮，写入下面的代码：

1. #001  Private Sub CommandButton2_Click()
   
2. #002      Unload Me
   
3. #003      ThisWorkbook.Saved = True
   
4. #004      Application.Quit
   
5. #005  End Sub

复制代码

代码解析：
       “取消”按钮的单击事件过程，在用户选择取消后退出程序。
       双击窗体上的组合框控件，写入下面的代码：

1. #001  Private Sub ComboBox1_Change()
   
2. #002      TextBox1.SetFocus
   
3. #003  End Sub

复制代码

代码解析：
       组合框控件的Change事件过程，在用户选择用户名后将焦点移到文本框中方便用户输入密码。

yuanzhuping

技巧197         收据系统
       步骤3，将Sheet3工作表名称重命名为“存档”，设置成如图所示的格式，用来保存已填写收据的数据。

       步骤4，“存档”表只是用来保存已开具收据的数据，而收据系统的日常操作都在“主界面”窗体中进行，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个多页（MultiPage）控件和一个状态栏（StatusBar）控件。在MultiPage控件的Page1页上添加一个Image控件和三个标签控件，在第一个标签的属性窗口中将其BackStyle属性设置为0，使标签背景为透明，在其他两个标签的Caption属性中写上版本信息及作者和邮箱，在Image控件的属性窗口将其Picture属性设置为合适的图片并调整好控件的大小与位置。

       双击主界面窗体，在打开的代码窗口写入下面的代码：

1. #001  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
2. #002  Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
   
3. #003  Private Declare Function CreateMenu Lib "user32" () As Long
   
4. #004  Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
   
5. #005  Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
   
6. #006  Private Declare Function CreatePopupMenu Lib "user32" () As Long
   
7. #007  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
8. #008  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
   
9. #009  Private Const GWL_WNDPROC = (-4)
   
10. #010  Private Const MF_STRING = &H0&
    
11. #011  Private Const MF_POPUP = &H10&
    
12. #012  Private Const MF_SEPARATOR = &H800&
    
13. #013  Dim MenuWnd As Long, Dump As Long, PopupMenuID As Long, PopupMenuWnd As Long, MenuID As Long
    
14. #014  Private Sub UserForm_Initialize()
    
15. #015      Dim i As Integer
    
16. #016      Dim str As String
    
17. #017      Dim arr As Variant
    
18. #018      If Val(Application.Version) < 9 Then
    
19. #019          hwnd = FindWindow("ThunderXFrame", Me.Caption)
    
20. #020      Else
    
21. #021          hwnd = FindWindow("ThunderDFrame", Me.Caption)
    
22. #022      End If
    
23. #023      MenuWnd = CreateMenu()
    
24. #024      PopupMenuID = CreatePopupMenu()
    
25. #025      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "系统(&S)")
    
26. #026      Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "单位设置(&C)")
    
27. #027      Dump = AppendMenu(PopupMenuID, MF_STRING, 101, "用户设置(&U)")
    
28. #028      Dump = AppendMenu(PopupMenuID, MF_STRING, 102, "切换用户(&S)")
    
29. #029      Dump = AppendMenu(PopupMenuID, MF_STRING, 103, "密码修改(&P)")
    
30. #030      Dump = AppendMenu(PopupMenuID, MF_STRING, 104, "打开Excel(&O)")
    
31. #031      Dump = AppendMenu(PopupMenuID, MF_STRING, 105, "退出系统(&Q)")
    
32. #032      PopupMenuID = CreatePopupMenu()
    
33. #033      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "编辑(&E)")
    
34. #034      Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "收款人(&R)")
    
35. #035      Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "交款人(&P)")
    
36. #036      Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "交款单位(&U)")
    
37. #037      Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "常用事由(&S)")
    
38. #038      Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "常用备注(&R)")
    
39. #039      PopupMenuID = CreatePopupMenu()
    
40. #040      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "操作(&O)")
    
41. #041      Dump = AppendMenu(PopupMenuID, MF_STRING, 120, "增加(&I)")
    
42. #042      Dump = AppendMenu(PopupMenuID, MF_STRING, 121, "查询(&Q)")
    
43. #043      PopupMenuID = CreatePopupMenu()
    
44. #044      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "帮助(&H)")
    
45. #045      Dump = AppendMenu(PopupMenuID, MF_STRING, 130, "帮助(&H)")
    
46. #046      Dump = AppendMenu(PopupMenuID, MF_STRING, 131, "关于(&R)")
    
47. #047      Dump = SetMenu(hwnd, MenuWnd)
    
48. #048      PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)
    
49. #049      SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess
    
50. #050      Me.MultiPage1.Value = 0
    
51. #051      For i = 2 To Sheet2.Range("A65536").End(xlUp).Row
    
52. #052          If Sheet2.Cells(i, 3) = "√" Then
    
53. #053              str = Sheet2.Cells(i, 1)
    
54. #054          End If
    
55. #055      Next
    
56. #056      arr = Array(168, 100, 100, 80)
    
57. #057      With Me.StatusBar1
    
58. #058          For i = 1 To 4
    
59. #059              .Panels.Add(i, , "").Style = 0
    
60. #060              .Panels(i).Width = arr(i - 1)
    
61. #061          Next
    
62. #062          .Panels(1).Text = Sheet2.Cells(2, 4) & "收据系统"
    
63. #063          .Panels(2).Text = "当前用户：" & str
    
64. #064          .Panels(3).Text = "今天是" & Format(Date, "yyyy年m月d日")
    
65. #065          .Panels(4).Text = Time
    
66. #066      End With
    
67. #067      Me.Caption = Sheet2.Cells(2, 4) & "收据系统"
    
68. #068      Me.Label12.Caption = Sheet2.Cells(2, 4) & "收据系统"
    
69. #069  End Sub
    
70. #070  Private Sub UserForm_Terminate()
    
71. #071      DestroyMenu MenuWnd
    
72. #072      DestroyMenu PopupMenuID
    
73. #073      DestroyMenu PopupMenuWnd
    
74. #074      SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
    
75. #075  End Sub

复制代码

代码解析：
       主界面窗体的Initialize事件过程，窗体显示时使用API函数添加菜单及状态栏信息。
       第1行到第13行代码，API函数声明。
       第18行到第49行代码，使用API函数添加菜单。请参阅技巧148 。
       第50行代码，窗体显示时选择MultiPage控件的第一页。
       第51行到第55行代码，将当前用户名赋给字符串变量str。
       第56行到第66行代码，在状态栏控件中添加四个窗格及显示的信息。请参阅技巧152 。
       第67、67行代码，设置主界面窗体的标题栏及标签显示的内容。
       步骤5，为了使用主界面窗体中添加的菜单，在VBE窗口中单击菜单“插入”→“模块”，在打开的代码窗口写入下面的代码：

1. #001  Public PreWinProc As Long, hwnd As Long
   
2. #002  Public Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
   
3. #003  Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
   
4. #004  Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
   
5. #005  Public Const MF_UNCHECKED = &H0&
   
6. #006  Public Const MF_CHECKED = &H8&
   
7. #007  Public Const MF_DISABLED = &H2&
   
8. #008  Public Const MF_GRAYED = &H1&
   
9. #009  Public Const MF_ENABLED = &H0&
   
10. #010  Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
11. #011  Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
    
12. #012  Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    
13. #013  Private Const MF_BYCOMMAND = &H0&
    
14. #014  Public Function MsgProcess(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
15. #015      Dim SubMenu_hWnd As Long
    
16. #016      Select Case wParam
    
17. #017          Case 100
    
18. #018              If Sheet2.Cells(2, 3) <> "√" Then
    
19. #019                  MsgBox "请使用系统管理员登陆系统!", 64, "提示"
    
20. #020              Else
    
21. #021                  设置使用单位.Show
    
22. #022              End If
    
23. #023          Case 101
    
24. #024              If Sheet2.Cells(2, 3) <> "√" Then
    
25. #025                  MsgBox "请使用系统管理员登陆系统!", 64, "提示"
    
26. #026              Else
    
27. #027                  用户设置.Show
    
28. #028              End If
    
29. #029          Case 102
    
30. #030              Unload 主界面
    
31. #031              登陆.Show
    
32. #032          Case 103
    
33. #033              修改密码.Show
    
34. #034          Case 104
    
35. #035              If Sheet2.Cells(2, 3) <> "√" Then
    
36. #036                  MsgBox "请使用系统管理员登陆系统!", 64, "提示"
    
37. #037              Else
    
38. #038                  Unload 主界面
    
39. #039                  Application.Visible = True
    
40. #040              End If
    
41. #041          Case 105
    
42. #042              If MsgBox("确定要退出收据系统吗?", 64 + vbYesNo, "提示") = vbYes Then
    
43. #043                  Unload 主界面
    
44. #044                  ThisWorkbook.Save
    
45. #045                  Application.Quit
    
46. #046              End If
    
47. #047          Case 110
    
48. #048              主界面.MultiPage1.Value = 0
    
49. #049              编辑收款人.Show
    
50. #050          Case 111
    
51. #051              主界面.MultiPage1.Value = 0
    
52. #052              编辑交款人.Show
    
53. #053          Case 112
    
54. #054              主界面.MultiPage1.Value = 0
    
55. #055              设置交款单位.Show
    
56. #056          Case 113
    
57. #057              主界面.MultiPage1.Value = 0
    
58. #058              编辑常用事由.Show
    
59. #059          Case 114
    
60. #060              主界面.MultiPage1.Value = 0
    
61. #061              编辑常用备注.Show
    
62. #062          Case 120
    
63. #063              主界面.MultiPage1.Value = 1
    
64. #064          Case 121
    
65. #065              主界面.MultiPage1.Value = 2
    
66. #066          Case 130
    
67. #067              帮助.Show
    
68. #068          Case 131
    
69. #069              关于.Show
    
70. #070          Case Else
    
71. #071              MsgProcess = CallWindowProc(PreWinProc, hwnd, Msg, wParam, lParam)
    
72. #072      End Select
    
73. #073  End Function

复制代码

代码解析：
       根据主界面窗体中添加菜单的ID设置其各项功能。
       第1行到第13行代码，API函数声明。
       第17行到第22行代码，“系统”菜单中的“单位设置”菜单功能，显示“设置使用单位”窗体设置收据系统的使用单位名称。其中第18、19行代码判断当前用户是否是系统管理员，只有系统管理员才能设置收据系统的使用单位名称。设置单位名称需使用“设置使用单位”窗体，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个框架控件、一个文本框控件及两个按钮按件，如图所示。
      
       双击窗体中的“确定”按钮，写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      If Sheet2.Cells(2, 4) <> "" Then
   
3. #003          If MsgBox("是否重新设置单位名称？", 36, "提示") = vbNo Then
   
4. #004              Unload Me
   
5. #005              Exit Sub
   
6. #006          End If
   
7. #007      End If
   
8. #008      If Trim(Me.Frame1.TextBox1.Value) = "" Then
   
9. #009          MsgBox "单位名称不能为空!", 64, "提示"
   
10. #010          Me.Frame1.TextBox1.SetFocus
    
11. #011          Exit Sub
    
12. #012      End If
    
13. #013      Sheet2.Cells(2, 4) = Trim(Me.Frame1.TextBox1.Value)
    
14. #014      主界面.Caption = Sheet2.Cells(2, 4) & "收据系统"
    
15. #015      主界面.Label12.Caption = Sheet2.Cells(2, 4) & "收据系统"
    
16. #016      主界面.StatusBar1.Panels(1).Text = Sheet2.Cells(2, 4) & "收据系统"
    
17. #017      Unload Me
    
18. #018  End Sub

复制代码

设置收据系统的使用单位名称并更新“主界面”窗体的标题、标签及状态栏中显示的信息。
       第23行到第28行代码，“系统”菜单中的“用户设置”菜单功能，显示“用户设置”窗体设置收据系统的用户名称。其中第24、25行代码判断当前用户是否是系统管理员，只有系统管理员才能设置收据系统的用户名称。设置用户名称需使用“用户设置”窗体，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加两个框架控件、一个列表框控件、一个文本框控件及三个按钮按件，如图所示。
      
       双击“用户设置”窗体写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      r = Sheet2.Range("A65536").End(xlUp).Row
   
5. #005      For i = 3 To r
   
6. #006          Me.Frame1.ListBox1.AddItem Sheet2.Cells(i, 1).Value
   
7. #007      Next
   
8. #008      Me.Frame2.TextBox1.SetFocus
   
9. #009  End Sub
   
10. #010  Private Sub CommandButton1_Click()
    
11. #011      Dim r As Integer
    
12. #012      Dim rng As Range
    
13. #013      If Me.Frame1.ListBox1.ListIndex < 0 Then
    
14. #014          MsgBox "请选择需删除的用户姓名!", 64, "提示"
    
15. #015          Exit Sub
    
16. #016      End If
    
17. #017      r = Sheet2.Range("A65536").End(xlUp).Row
    
18. #018      With Sheet2.Range("A3:F" & r)
    
19. #019          Set rng = .Find(What:=Me.Frame1.ListBox1.Value, _
    
20. #020              After:=.Cells(.Cells.Count), _
    
21. #021              LookIn:=xlValues, _
    
22. #022              LookAt:=xlWhole, _
    
23. #023              SearchOrder:=xlByRows, _
    
24. #024              SearchDirection:=xlNext, _
    
25. #025              MatchCase:=False)
    
26. #026          If Not rng Is Nothing Then
    
27. #027              rng.Offset(0, 1).Delete Shift:=xlUp
    
28. #028              rng.Delete Shift:=xlUp
    
29. #029              Me.Frame1.ListBox1.RemoveItem (ListBox1.ListIndex)
    
30. #030              MsgBox "已经成功删除!", 64, "提示"
    
31. #031          End If
    
32. #032      End With
    
33. #033  End Sub
    
34. #034  Private Sub CommandButton2_Click()
    
35. #035      Dim r As Integer
    
36. #036      With Me.Frame2.TextBox1
    
37. #037          r = Sheet2.Range("A65536").End(xlUp).Row
    
38. #038          If Trim(.Value) = "" Then
    
39. #039              MsgBox "用户姓名不能为空!", 64, "提示"
    
40. #040              .SetFocus
    
41. #041              Exit Sub
    
42. #042          End If
    
43. #043          If WorksheetFunction.CountIf(Sheet2.Range("A3:A" & r), Trim(.Text)) > 0 Then
    
44. #044              MsgBox "用户已经存在!", 64, "提示"
    
45. #045              .Value = ""
    
46. #046              Exit Sub
    
47. #047          End If
    
48. #048          Sheet2.Range("A" & r + 1) = Trim(.Text)
    
49. #049          Me.Frame1.ListBox1.AddItem Trim(.Text)
    
50. #050          .Value = ""
    
51. #051          .SetFocus
    
52. #052      End With
    
53. #053      MsgBox "用户成功增加!", 64, "提示"
    
54. #054  End Sub
    
55. #055  Private Sub CommandButton3_Click()
    
56. #056      Unload Me
    
57. #057  End Sub

复制代码

用户设置窗体显示时列表框控件显示系统中已有用户的名称，因为系统管理员是不能删除的，所以并不显示。单击“删除”按钮可以删除列表框中选中的用户。单击“增加”按钮可以新增用户，新增用户的初始密码为空，登陆系统后可以重新设置密码。
       第29行到第31行代码，“系统”菜单中的“切换用户”菜单功能，关闭主界面窗体，显示系统登陆窗体。
       第32、33行代码，“系统”菜单中的“密码修改”菜单功能，显示“密码修改”窗体重新设置当前用户的密码，设置用户密码需使用“密码修改”窗体，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个框架控件、三个文本框控件及两个按钮按件，如图所示。
      
       双击“密码修改”窗体写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      Dim p As Integer
   
5. #005      Dim Password As String
   
6. #006      With Sheet2
   
7. #007          r = .Range("A65536").End(xlUp).Row
   
8. #008          For i = 2 To r
   
9. #009              If .Cells(i, 3) = "√" Then
   
10. #010                  Password = .Cells(i, 2).Text
    
11. #011                  p = i
    
12. #012                  Exit For
    
13. #013              End If
    
14. #014          Next
    
15. #015          If Me.TextBox1.Text <> Password Then
    
16. #016              MsgBox "对不起,密码不正确,你无权修改!", 64, "提示"
    
17. #017              Me.TextBox1 = ""
    
18. #018              Me.TextBox1.SetFocus
    
19. #019              Exit Sub
    
20. #020          End If
    
21. #021          If Me.TextBox2.Text <> Me.TextBox3.Text Then
    
22. #022              MsgBox "确认密码不一致,请重新输入!", 64, "提示"
    
23. #023              Me.TextBox3 = ""
    
24. #024              Me.TextBox3.SetFocus
    
25. #025              Exit Sub
    
26. #026          End If
    
27. #027          .Cells(p, 2) = Me.TextBox3.Text
    
28. #028      End With
    
29. #029      Unload Me
    
30. #030  End Sub

复制代码

使用“密码修改”窗体可以重新设置当前用户的密码。第15行到第20行代码判断所输入的旧密码是否正确，第21行到第26行代码判断两次输入的新密码是否一致，第27行代码，将新密码写入到工作表中。
       第34行到第40行代码，“系统”菜单中的“打开Excel”菜单功能，收据系统日常使用时只能在主界面窗体中操作，只有系统管理员才能打开工作表对其进行修改。
       第41行到第46行代码，“系统”菜单中的“退出系统”菜单功能，关闭Excel程序。
       第47行第61行代码，“编辑”菜单的各项功能，对使用收据系统所需要的一些信息进行添加和删除。其中第47、48行代码显示“编辑收款人”窗体对常用收款人进行编辑，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加两个框架控件、一个列表框控件、一个文本框控件及三个按钮按件，如图所示。
      
       其他窗体与“编辑收款人”窗体类似，窗体中的代码请参考“用户设置”窗体中的代码。
       第62、63行代码，“操作”菜单中的“增加”菜单功能，选择主界面窗体中多页控件的Page2页，可以填写、打印收据。
       第64、65行代码，“操作”菜单中的“查询”菜单功能，选择主界面窗体中多页控件的Page3页，可以对已填写收据进行查询、打印。
       第66、67行代码，“帮助”菜单中的“关于”菜单功能，显示“关于”窗体。
       第68、69行代码，“帮助”菜单中的“帮助”菜单功能，显示“帮助”窗体。

yuanzhuping

技巧197         收据系统
       步骤6，在VBE窗口中选择“主界面”窗体的Page2页，在Page2页中添加四个按钮控件、一个框架控件，框架控件中添加六个文本框控件、四个组合框控件及相应的标签和一个DTP控件，如图所示。

       双击窗体上的“新增”按钮，写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      Dim Number As String
   
5. #005      With Sheet2
   
6. #006          If .Range("D2") = "" Then
   
7. #007              MsgBox "请先设置使用单位!", 64, "提示"
   
8. #008              Exit Sub
   
9. #009          End If
   
10. #010          MultiPage1.Page2.TextBox2 = .Range("D2")
    
11. #011          If .Cells(2, 3) = "√" Then
    
12. #012              MsgBox "请以用户身份登陆!", 64, "提示"
    
13. #013              Exit Sub
    
14. #014          End If
    
15. #015          r = .Range("A65536").End(xlUp).Row
    
16. #016          For i = 3 To r
    
17. #017              If .Cells(i, 3) = "√" Then
    
18. #018                  MultiPage1.Page2.TextBox5 = .Cells(i, 1)
    
19. #019              End If
    
20. #020          Next
    
21. #021      End With
    
22. #022      With Sheet3
    
23. #023          r = .Range("A65536").End(xlUp).Row
    
24. #024          If .Range("A2") = "" Then
    
25. #025              Number = Year(DTPicker1.Value) & Format(1, "0000")
    
26. #026          End If
    
27. #027          If Val(Year(DTPicker1.Value)) > Val(Left(.Range("A" & r).Value, 4)) Then
    
28. #028              Number = Year(DTPicker1.Value) & Format(1, "0000")
    
29. #029          Else
    
30. #030              Number = Format(.Range("A" & r).Value + 1, "00000000")
    
31. #031          End If
    
32. #032      End With
    
33. #033      With MultiPage1.Page2
    
34. #034          .ComboBox1.Value = ""
    
35. #035          .ComboBox2.Value = ""
    
36. #036          .ComboBox3.Value = ""
    
37. #037          .ComboBox4.Value = ""
    
38. #038          .TextBox1.Value = Number
    
39. #039          .TextBox3.Value = ""
    
40. #040          .TextBox4.Value = ""
    
41. #041          .TextBox6.Value = ""
    
42. #042      End With
    
43. #043  End Sub

复制代码

代码解析：
       “新增”按钮的单击过程，将收据号码、使用单位及用户名称显示在文本框中。
       第6行到第9行代码，判断收据系统是否已设置使用单位。
       第10行代码，将工作表中已设置好的单位名称显示在“收款单位名称”文本框中。
       第11行到第14行代码，判断当前用户是否是系统管理员，系统管理员不能进行新增收据的操作。
       第15行到第20行代码，将当前用户的名称显示在“签发人”文本框中。
       第23行到第26行代码，判断收据系统是否第一次使用。如果是第一次使用，新增收据号码为当前年份加0001。
       第27、28行代码，判断收据系统是否是跨年度使用。如果是跨年度使用，新增收据号码为当前年份加0001。
       第30行代码，如果收据系统是本年度中正常使用且已开具过收据，新增收据号码为最后所开具的收据号码加一。
       第33行到第42行代码，将收据号码显示在“收据号码”文本框中并清除其他内容。
       填写完毕的收据需保存到工作表中，将Sheet3工作表重命名为“存档”表并设置成如图所示的格式用来保存已开具收据的各项内容。

       双击窗体上的“保存”按钮，写入下面的代码：

1. #001  Private Sub CommandButton2_Click()
   
2. #002      Dim r As Integer
   
3. #003      r = Sheet3.Range("A65536").End(xlUp).Row
   
4. #004      If MultiPage1.Page2.TextBox1 = "" Then
   
5. #005          MsgBox "没有可保存的收据,请选择新增按钮!", 64, "提示"
   
6. #006          Exit Sub
   
7. #007      End If
   
8. #008      If WorksheetFunction.CountIf(Sheet3.Range("A2:A" & r), Trim(MultiPage1.Page2.TextBox1.Text)) > 0 Then
   
9. #009          MsgBox "收据已经保存!", 64, "提示"
   
10. #010          Exit Sub
    
11. #011      End If
    
12. #012      If If Sheet3.Range("A2") <> "" And MultiPage1.Page2.DTPicker1.Value < Sheet3.Cells(r, 2) Then
    
13. #013          MsgBox "日期错误，请重新选择日期!", 64, "提示"
    
14. #014          Exit Sub
    
15. #015      End If
    
16. #016      If MultiPage1.Page2.ComboBox4.Value = "" Then
    
17. #017          MsgBox "请填写交款事由!", 64, "提示"
    
18. #018          MultiPage1.Page2.ComboBox4.SetFocus
    
19. #019          Exit Sub
    
20. #020      End If
    
21. #021      If MultiPage1.Page2.ComboBox1.Value = "" Then
    
22. #022          MsgBox "请填写交款单位!", 64, "提示"
    
23. #023          MultiPage1.Page2.ComboBox1.SetFocus
    
24. #024          Exit Sub
    
25. #025      End If
    
26. #026      If MultiPage1.Page2.ComboBox2.Value = "" Then
    
27. #027          MsgBox "请填写收款人姓名!", 64, "提示"
    
28. #028          MultiPage1.Page2.ComboBox2.SetFocus
    
29. #029          Exit Sub
    
30. #030      End If
    
31. #031      If MultiPage1.Page2.ComboBox3.Value = "" Then
    
32. #032          MsgBox "请填写交款人姓名!", 64, "提示"
    
33. #033          MultiPage1.Page2.ComboBox3.SetFocus
    
34. #034          Exit Sub
    
35. #035      End If
    
36. #036      If MultiPage1.Page2.TextBox4.Value = "" Then
    
37. #037          MsgBox "请填写收款金额!", 64, "提示"
    
38. #038          MultiPage1.Page2.TextBox4.SetFocus
    
39. #039          Exit Sub
    
40. #040      End If
    
41. #041      If MultiPage1.Page2.TextBox6.Value = "" Then
    
42. #042          MsgBox "请填写备注!", 64, "提示"
    
43. #043          MultiPage1.Page2.TextBox6.SetFocus
    
44. #044          Exit Sub
    
45. #045      End If
    
46. #046      With Sheet3
    
47. #047          .Cells(r + 1, 1) = MultiPage1.Page2.TextBox1.Value
    
48. #048          .Cells(r + 1, 2) = MultiPage1.Page2.DTPicker1.Value
    
49. #049          .Cells(r + 1, 3) = MultiPage1.Page2.ComboBox4.Value
    
50. #050          .Cells(r + 1, 4) = MultiPage1.Page2.ComboBox1.Value
    
51. #051          .Cells(r + 1, 5) = MultiPage1.Page2.ComboBox3.Value
    
52. #052          .Cells(r + 1, 6) = MultiPage1.Page2.TextBox2.Value
    
53. #053          .Cells(r + 1, 7) = MultiPage1.Page2.ComboBox2.Value
    
54. #054          .Cells(r + 1, 8) = MultiPage1.Page2.TextBox3.Value
    
55. #055          .Cells(r + 1, 9) = MultiPage1.Page2.TextBox4.Value
    
56. #056          .Cells(r + 1, 10) = MultiPage1.Page2.TextBox6.Value
    
57. #057          .Cells(r + 1, 11) = MultiPage1.Page2.TextBox2.Value
    
58. #058          .Cells(r + 1, 12) = MultiPage1.Page2.TextBox5.Value
    
59. #059      End With
    
60. #060      Sheet4.Range("K1") = MultiPage1.Page2.TextBox1.Value
    
61. #061      MsgBox "收据已保存，请打印!", 64, "提示"
    
62. #062  End Sub

复制代码

代码解析：
       “保存”按钮的单击过程，将填写完整的收据内容保存到“存档”表中。
       第4行到第7行代码，判断是否已选择“新增”按钮。因为“收据号码”文本框中的号码是不能通过手工输入的，只能选择“新增”按钮由系统输入。
       第8行到第11行代码，判断收据号码与“存档”表中保存的收据号码是否重复，使同一收据不能重复保存。
       第12行到第15行代码，判断收据日期是否大于等于“存档”表中保存的最后一张收据的日期，使收据只能按日期顺序开具。
       第16行到第45行代码，判断收据内容是否填写完整。
       第46行到第59行代码，将收据内容保存到“存档”表的最后一行。
       第60行代码，将所开收据的号码写入到“打印”表的K1单元格。
       收据保存后需要打印，将Sheet4工作表重命名为“打印”表。因为笔者所在单位不使用针式打印机，不能进行套打，所以将“打印”表设置成如图所示的格式，使用激光打印机打印。如果需要进行套打，只需按所需要打印收据的页面重新进行设置即可。

       “打印”表中的单元格写入VLOOKUP函数，根据K1单元格中的号码在“存档”表中查找相应的数据显示在各单元格中。
       双击窗体上的“打印”按钮，写入下面的代码：

1. #001  Private Sub CommandButton3_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim rng As Range
   
4. #004      With Sheet3
   
5. #005          r = .Range("A65536").End(xlUp).Row
   
6. #006          If MultiPage1.Page2.TextBox1.Value = "" Then
   
7. #007              MsgBox "没有可打印的收据!", 64, "提示"
   
8. #008              Exit Sub
   
9. #009          End If
   
10. #010          If WorksheetFunction.CountIf(.Range("A2:A" & r), Trim(MultiPage1.Page2.TextBox1.Text)) = 0 Then
    
11. #011              MsgBox "请保存后再打印!", 64, "提示"
    
12. #012              Exit Sub
    
13. #013          End If
    
14. #014          With .Range("A2:A" & r)
    
15. #015              Set rng = .Find(What:=MultiPage1.Page2.TextBox1.Value, _
    
16. #016                  After:=.Cells(.Cells.Count), _
    
17. #017                  LookIn:=xlValues, _
    
18. #018                  LookAt:=xlWhole, _
    
19. #019                  SearchOrder:=xlByRows, _
    
20. #020                  SearchDirection:=xlNext, _
    
21. #021                  MatchCase:=False)
    
22. #022              If Not rng Is Nothing Then
    
23. #023                  If rng.Offset(0, 12).Text = "√" Then
    
24. #024                      MsgBox "已经打印的收据不可再打印!", 64, "提示"
    
25. #025                      Exit Sub
    
26. #026                  End If
    
27. #027              End If
    
28. #028          End With
    
29. #029          .Range("M" & r).Value = "√"
    
30. #030      End With
    
31. #031      Sheet4.Range("K1") = MultiPage1.Page2.TextBox1.Value
    
32. #032      Sheet4.PrintOut
    
33. #033  End Sub

复制代码

代码解析：
       “打印”按钮的单击过程，打印收据。
       第6行到第9行代码，判断是否有需要打印的收据。
       第10行到第13行代码，判断当前收据是否已经保存。
       第14行到第28行代码，判断当前收据是否已经打印。已经打印过的收据在“存档”表的M列中会写上已打印标识“√”。
       第29行代码，在“存档”表的该收据内容所在的M列中写上已打印标识“√”。
       第31、32行代码，将收据号码写入到“打印”表的K1单元格，打印该收据。
       双击窗体上的“取消”按钮，写入下面的代码：

1. #001  Private Sub CommandButton4_Click()
   
2. #002      With MultiPage1.Page2
   
3. #003          .ComboBox1.Value = ""
   
4. #004          .ComboBox2.Value = ""
   
5. #005          .ComboBox3.Value = ""
   
6. #006          .ComboBox4.Value = ""
   
7. #007          .TextBox1.Value = ""
   
8. #008          .TextBox3.Value = ""
   
9. #009          .TextBox4.Value = ""
   
10. #010          .TextBox6.Value = ""
    
11. #011      End With
    
12. #012      主界面.MultiPage1.Value = 0
    
13. #013  End Sub

复制代码

代码解析：
       “取消”按钮的单击过程，清除数据并返回主界面的Page1页面。
       为了方便收据的填写，在开具收据时，日期由DTP控件选择，事由、单位名称、收款人及交款人可以手工输入，也可以从窗体中的组合框中选择已有的信息。双击MultiPage1控件写入下面的代码：

1. #001  Private Sub MultiPage1_Change()
   
2. #002      Dim i As Integer
   
3. #003      Dim c As Integer
   
4. #004      Select Case MultiPage1.Value
   
5. #005          Case 1
   
6. #006              For c = 1 To 4
   
7. #007                  MultiPage1.Page2.Controls("ComboBox" & c).Clear
   
8. #008                  For i = 2 To Sheet2.Cells(65536, c + 4).End(xlUp).Row
   
9. #009                      MultiPage1.Page2.Controls("ComboBox" & c).AddItem Sheet2.Cells(i, c + 4).Value
   
10. #0010                  Next
    
11. #011              Next
    
12. #012              MultiPage1.Page2.DTPicker1 = Date
    
13. #013          Case 2
    
14. #014              With MultiPage1.Page3.ListView1
    
15. #015                  .ListItems.Clear
    
16. #016                  .ColumnHeaders.Add , , Space(3) & "号码", 54, 0
    
17. #017                  .ColumnHeaders.Add , , Space(3) & "日期", 54, 0
    
18. #018                  .ColumnHeaders.Add , , Space(12) & "事由", 130, 0
    
19. #019                  .ColumnHeaders.Add , , Space(6) & "交款单位", 100, 0
    
20. #020                  .ColumnHeaders.Add , , "交款人", 40, 0
    
21. #021                  .ColumnHeaders.Add , , Space(6) & "收款单位", 90, 0
    
22. #022                  .ColumnHeaders.Add , , "收款人", 40, 0
    
23. #023                  .ColumnHeaders.Add , , Space(10) & "金额大写", 130, 0
    
24. #024                  .ColumnHeaders.Add , , "金额小写", 50, 1
    
25. #025                  .ColumnHeaders.Add , , Space(14) & "备注", 150, 0
    
26. #026                  .ColumnHeaders.Add , , Space(5) & "填发单位", 84, 0
    
27. #027                  .ColumnHeaders.Add , , "签发人", 40, 0
    
28. #028                  .View = lvwReport
    
29. #029                  .Gridlines = True
    
30. #030                  .FullRowSelect = True
    
31. #031              End With
    
32. #032      End Select
    
33. #033  End Sub

复制代码

代码解析：
       MultiPage控件的Change事件过程。
       第6行到第12行代码，当选择MultiPage控件的Page2页面即新增收据时，将“维护”表中所保存的信息加载到组合框中，并将DTP控件的日期设置为当前日期。
       第13行到第31行代码，当选择MultiPage控件的Page3页面即查询收据时，为Page3页中的ListView控件添加列标题。请参阅技巧131 。

yuanzhuping

技巧197         收据系统
       为了将输入的小写金额转换为人民币大写金额，在VBE窗口中单击菜单“插入”→“模块”，在打开的代码窗口写入下面的代码：

1. #001  Public Function RMBDX(M)
   
2. #002      On Error Resume Next
   
3. #003      RMBDX = Replace(Application.Text(Round(M + 0.00000001, 2), "[DBnum2]"), ".", "元")
   
4. #004      RMBDX = IIf(Left(Right(RMBDX, 3), 1) = "元", Left(RMBDX, Len(RMBDX) - 1) & "角" & Right(RMBDX, 1) & "分", IIf(Left(Right(RMBDX, 2), 1) = "元", RMBDX & "角整", IIf(RMBDX = "零", "", RMBDX & "元整")))
   
5. #005      RMBDX = Replace(Replace(Replace(Replace(RMBDX, "零元零角", ""), "零元", ""), "零角", "零"), "-", "负")
   
6. #006  End Function

复制代码

代码解析：
       自定义RMBDX函数，将小写金额转换为人民币大写金额，请参阅技巧163 。
       双击小写金额文本框，写入下面的代码：

1. #001  Private Sub TextBox4_Change()
   
2. #002      If Not IsNumeric(TextBox4.Text) And TextBox4.Text <> "" Then
   
3. #003          MsgBox "请输入正确的小写金额!", 64, "提示"
   
4. #004          Exit Sub
   
5. #005      End If
   
6. #006      MultiPage1.Page2.TextBox3 = RMBDX(MultiPage1.Page2.TextBox4.Value)
   
7. #007  End Sub
   
8. #008  Private Sub TextBox4_AfterUpdate()
   
9. #009      Me.TextBox4.Value = Format(TextBox4.Value, "0.00")
   
10. #010  End Sub

复制代码

代码解析：
       第1行到第6行代码，文本框的Change事件过程，将小写文本框中输入的正确的小写金额转换为人民币大写金额写入到大写文本框中。
       第8行到第10行代码，文本框的AfterUpdate事件过程，将小写金额格式化为两位小数格式。
       备注可以手工输入，也可以从窗体中选择已有的信息。在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个MultiPage控件和两个按钮按件，在MultiPage控件的Page1页中添加一个框架控件，在框架控件中添加六个文本框控件、六个标签控件，如图所示。
      
       在MultiPage控件的Page2页中添加一个框架控件，在框架控件中添加两个文本框控件和两个标签控件，如图所示。
      
       在MultiPage控件的Page3页中添加一个框架控件，在框架控件中添加一个列表框控件，如图所示。
      
       双击“输入常用备注”窗体，写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim r As Integer
   
3. #003      Dim i As Integer
   
4. #004      MultiPage1.Value = 0
   
5. #005      r = Sheet2.Range("I65536").End(xlUp).Row
   
6. #006      For i = 2 To r
   
7. #007          MultiPage1.Page3.ListBox1.AddItem Sheet2.Cells(i, 9).Value
   
8. #008      Next
   
9. #009  End Sub

复制代码

代码解析：
       “输入常用备注”窗体的Initialize事件，窗体显示时MultiPage控件选择Page1页并将“维护”表中保存的常用备注信息加载到Page3页的列表框中。
       双击“输入常用备注”窗体的“确定”按钮，写入下面的代码：

1. #001  Private Sub CommandButton1_Click()
   
2. #002      Dim str As String
   
3. #003      Dim dou As Double
   
4. #004      Dim i As Integer
   
5. #005      With MultiPage1
   
6. #006          Select Case .Value
   
7. #007              Case 0
   
8. #008                  For i = 1 To 6
   
9. #009                      str = str & .Page1.Controls("Label" & i) & Chr(9) & .Page1.Controls("TextBox" & i) & "元" & Chr(9)
   
10. #010                      If i = 2 Or i = 4 Then
    
11. #011                          str = str & Chr(10)
    
12. #012                      End If
    
13. #013                      dou = dou + Val(.Page1.Controls("TextBox" & i).Value)
    
14. #014                  Next
    
15. #015              Case 1
    
16. #016                  For i = 7 To 8
    
17. #017                      str = str & .Page2.Controls("Label" & i) & .Page2.Controls("TextBox" & i) & "元" & Chr(9)
    
18. #018                      dou = dou + Val(.Page2.Controls("TextBox" & i).Value)
    
19. #019                  Next
    
20. #020              Case 2
    
21. #021                  str = .Page3.ListBox1.Value
    
22. #022                  dou = 0
    
23. #023          End Select
    
24. #024      End With
    
25. #025      With 主界面.MultiPage1.Page2
    
26. #026          .TextBox6 = str
    
27. #027          .TextBox4 = IIf(dou <> 0, Format(dou, "0.00"), .TextBox4)
    
28. #028      End With
    
29. #029      Unload Me
    
30. #030  End Sub

复制代码

代码解析：
       “输入常用备注”窗体中“确定”按钮的单击过程，将常用备注及小写金额写入到主界面窗体的备注文本框及小写金额文本框中。
       双击“输入常用备注”窗体中Page3页的列表框，写入下面的代码：

1. #001  Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   
2. #002      主界面.MultiPage1.Page2.TextBox6 = MultiPage1.Page3.ListBox1
   
3. #003      Unload Me
   
4. #004  End Sub

复制代码

代码解析：
       “输入常用备注”窗体中列表框的双击过程，将选中的备注写入到主界面窗体的备注文本框中。
       双击“输入常用备注”窗体中的TextBox1文本框，写入下面的代码：

1. Private Sub TextBox1_AfterUpdate()
   
2.     MultiPage1.Page1.TextBox1 = Format(MultiPage1.Page1.TextBox1, "0.00")
   
3. End Sub

复制代码

代码解析：
       “输入常用备注”窗体中文本框的AfterUpdate事件过程，将金额格式化为两位小数格式。其他文本框设置与之相同。

yuanzhuping

技巧197         收据系统
       步骤7，在VBE窗口中选择“主界面”窗体的Page3页，在Page3页中添加一个ListView控件和三个按钮控件，如图 所示。

       双击窗体中的“查询”按钮，写入下面的代码：

1. #001  Private Sub CommandButton6_Click()
   
2. #002      Dim Itm As ListItem
   
3. #003      Dim r As Integer
   
4. #004      Dim c As Integer
   
5. #005      r = Sheet3.Range("A65536").End(xlUp).Row
   
6. #006      With MultiPage1.Page3.ListView1
   
7. #007          .ListItems.Clear
   
8. #008          For r = 2 To r
   
9. #009              Set Itm = .ListItems.Add()
   
10. #010              Itm.Text = Space(2) & Sheet3.Cells(r, 1)
    
11. #011              For c = 1 To 11
    
12. #012                  Itm.SubItems(c) = Sheet3.Cells(r, c + 1)
    
13. #013              Next
    
14. #014              Itm.SubItems(1) = Format(Itm.SubItems(1), "yyyy-mm-dd")
    
15. #015              Itm.SubItems(8) = Format(Itm.SubItems(8), "0.00")
    
16. #016          Next
    
17. #017      End With
    
18. #018      Set Itm = Nothing
    
19. #019  End Sub

复制代码

代码解析：
       “查询”按钮的单击过程，将“存档”表中已开具收据的信息显示到ListView控件中，请参阅技巧131 。
       双击窗体中的“打印”按钮，写入下面的代码：

1. #001  Private Sub CommandButton5_Click()
   
2. #002      Dim r As Integer
   
3. #003      Dim rng As Range
   
4. #004      Dim str As String
   
5. #005      str = Val(MultiPage1.Page3.ListView1.SelectedItem)
   
6. #006      r = Sheet3.Range("A65536").End(xlUp).Row
   
7. #007      With Sheet3.Range("A2:A" & r)
   
8. #008          Set rng = .Find(What:=str, _
   
9. #009              After:=.Cells(.Cells.Count), _
   
10. #010              LookIn:=xlValues, _
    
11. #011              LookAt:=xlWhole, _
    
12. #012              SearchOrder:=xlByRows, _
    
13. #013              SearchDirection:=xlNext, _
    
14. #014              MatchCase:=False)
    
15. #015          If Not rng Is Nothing Then
    
16. #016              If rng.Offset(0, 12).Text = "√" Then
    
17. #017                  MsgBox "已经打印的收据不可再打印!", 64, "提示"
    
18. #018              Else
    
19. #019                  With Sheet4
    
20. #020                      .Range("K1") = str
    
21. #021                      .PrintOut
    
22. #022                  End With
    
23. #023                  Sheet3.Range("M" & Rng.Row).Value = "√"
    
24. #024              End If
    
25. #025          End If
    
26. #026      End With
    
27. #027  End Sub

复制代码

代码解析：
       “打印”按钮的单击过程，将“存档”表中已开具保存还没有打印的收据重新打印。
       第5行代码，将ListView控件中所选中的收据号码赋给变量str。
       第7行到第14行代码，使用该号码在“存档”表中查找数据。
       第16、17行代码，如果该号码所在行的M列已有打印标识则不能打印。
       第20、21行代码，如果该号码没有打印则将号码写入到“打印”表的K1单元格并打印收据。
       在日常使用时，如果确实要重新打印收据，可以以系统管理员身份进入系统，在窗体菜单中打开Excel，删除打印标识。
       步骤8，在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个框架控件，在框架控件中添加一个标签控件，双击窗体写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim str As String
   
3. #003      str = Space(4) & "欢迎使用" & vbLf _
   
4. #004          & Space(4) & "使用前请仔细阅读使用说明：" & vbLf _
   
5. #005          & Space(4) & "一、第一次使用本系统时请以系统管理员身份登陆。" & vbLf _
   
6. #006          & Space(4) & "二、第一次使用本系统时请先设置使用单位和添加用户。" & vbLf _
   
7. #007          & Space(4) & "三、常用信息可以自行增加及删除。" & vbLf _
   
8. #008          & Space(4) & "四、开具的收据只能打印一次，未打印的收据可以在查询界面中补充打印。" & vbLf _
   
9. #009          & vbLf _
   
10. #010          & Space(4) & "使用过程中如有问题或好的建议请与我联系：" & vbLf _
    
11. #011          & Space(4) & "Tel：0513-86548930" & vbLf _
    
12. #012          & Space(4) & "Tel：13861958666" & vbLf _
    
13. #013          & Space(4) & "E-mail： yuanzhuping@yeah.net"
    
14. #014      Label8.Caption = str
    
15. #015      Label8.Height = 150
    
16. #016      Label8.Top = 6
    
17. #017      Label8.Left = 6
    
18. #018      Frame1.ScrollBars = fmScrollBarsVertical
    
19. #019      Frame1.ScrollHeight = Label8.Height
    
20. #020  End Sub

复制代码

代码解析：
       使用窗体显示系统帮助信息，请参阅技巧122 。窗体运行后效果如图所示。
      
       在VBE窗口中单击菜单“插入”→“插入窗体”，在窗体中添加一个Image控件和一个框架控件，在框架控件中添加一个Image控件和一个标签控件，在Image控件的属性窗口将其Picture属性设置为合适的图片，双击窗体写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      Dim str As String
   
3. #003      str = Sheet2.Cells(2, 4) & "收据系统" & vbLf _
   
4. #004          & "版本： V2.0.00" & vbLf _
   
5. #005          & "版权： (C) 2009-2022" & vbLf _
   
6. #006          & "作者： yuanzhuping (2009-7-8)" & vbLf _
   
7. #007          & "邮箱： yuanzhuping@yeah.net "
   
8. #008      Label1.Caption = str
   
9. #009  End Sub

复制代码

代码解析：
       使用窗体显示系统信息。窗体运行后效果如图所示。
      
       步骤9，在“主界面”窗体的属性窗口中选择MultiPage控件，将其Style属性设置为2，使其不显示MultiPage控件的标签。
       步骤10，因为收据系统正常使用时只需在“主界面”窗体操作，所以隐藏工作簿，在VBE的“工程”窗口双击ThisWorkbook，在打开的代码窗口写入下面的代码：

1. #001  Private Sub Workbook_Open()
   
2. #002      Application.Visible = False
   
3. #003      登陆.Show
   
4. #004  End Sub

复制代码

代码解析：
       收据系统打开时隐藏工作簿，显示“登陆”窗体供用户登陆。
       步骤11，使用收据系统，在打开时必需启用宏，所以将工作簿设置为禁用宏则关闭工作簿。请参阅技巧44 。
       步骤12，设置VBA工程的密码。示例VBA工程密码为六个8。
       保存工作簿后重新打开，显示如图所示的“登陆”窗体供用户登陆，第一次使用时默认用户为“系统管理员”，初始密码为六个8。
      
       在密码输入框中输入正确的密码后按“登陆”按钮后显示如图所示的“主界面”操作窗体。
      
       选择“系统”菜单，设置使用单位和用户后选择“操作”菜单中的“增加”菜单，进入如图所示的收据开具界面。
      
        选择“操作”菜单中的“查询”菜单，进入收据查询界面，按“查询”按钮后查询结果如图所示。
      
. 技巧197 收据系统.rar (233.24 KB, 下载次数: 1080)

2009-7-19 11:49 上传

点击文件名下载附件

上面的附件在查询后补发收据时有个错误，重新上传。
技巧197 收据系统.rar (233.27 KB, 下载次数: 3291)

2009-7-20 09:00 上传

点击文件名下载附件

[ 本帖最后由 yuanzhuping 于 2009-7-20 09:01 编辑 ]