VBA常用技巧代码解析

pengeb

版主真的太伟大了,太无私奉献了,下载到凌晨12.30下载完了,先收藏,慢慢学习,不会还要向版主请教哦!!!

yuanzhuping

技巧148         在用户窗体上添加菜单
       在VBA中，用户窗体上是没有菜单的，为了使用方便，我们可以使用API函数在用户窗体上添加菜单，示例代码如下：

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      If Val(Application.Version) < 9 Then
    
16. #016          hwnd = FindWindow("ThunderXFrame", Me.Caption)
    
17. #017      Else
    
18. #018          hwnd = FindWindow("ThunderDFrame", Me.Caption)
    
19. #019      End If
    
20. #020      MenuWnd = CreateMenu()
    
21. #021      PopupMenuID = CreatePopupMenu()
    
22. #022      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "系统设置(&X)")
    
23. #023      Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "保存(&S)...")
    
24. #024      Dump = AppendMenu(PopupMenuID, MF_STRING, 101, "备份(&E)")
    
25. #025      Dump = AppendMenu(PopupMenuID, MF_STRING, 102, "退出(&X)")
    
26. #026      PopupMenuID = CreatePopupMenu()
    
27. #027      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计凭证(&P)")
    
28. #028      Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "录入(&L)")
    
29. #029      Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "审核(&C)")
    
30. #030      PopupMenuID = CreatePopupMenu()
    
31. #031      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计账簿(&Z)")
    
32. #032      Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "记账(&T)")
    
33. #033      Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "结账(&J)")
    
34. #034      PopupMenuID = CreatePopupMenu()
    
35. #035      Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计报表(&B)")
    
36. #036      Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "资产负债表(&F)")
    
37. #037      Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "损益表(&Y)")
    
38. #038      Dump = SetMenu(hwnd, MenuWnd)
    
39. #039      PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)
    
40. #040      SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess
    
41. #041  End Sub
    
42. #042  Private Sub UserForm_Terminate()
    
43. #043      DestroyMenu MenuWnd
    
44. #044      DestroyMenu PopupMenuID
    
45. #045      DestroyMenu PopupMenuWnd
    
46. #046      SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
    
47. #047  End Sub

复制代码

代码解析：
       第1行到第13行代码，API函数声明。
       第14行到第41代码，用户窗体的Initialize事件过程，在窗体显示时使用API函数在窗体上添加菜单。其中第22行代码添加第一个“系统设置”菜单，第23、24、25行代码在“系统设置”菜单中添加三个子菜单，第26行代码往下继续添加其他菜单。
       第40行代码，为窗体中添加的菜单指定所执行的过程名称为“MsgProcess”函数过程。
       第42行到第47行代码，用户窗体的Terminate事件过程，将所有引用对象的变量设置成Nothing，从而删除对象的所有引用。
       为了能够使用窗体中添加的菜单，需要在模块中写入下面的代码：

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              MsgBox "你选择的是""保存""按钮!"
    
19. #019          Case 101
    
20. #020              MsgBox "你选择的是""备份""按钮!"
    
21. #021          Case 102
    
22. #022              Unload UserForm1
    
23. #023          Case 110
    
24. #024              MsgBox "你选择的是""录入""按钮!"
    
25. #025          Case 111
    
26. #026              MsgBox "你选择的是""审核""按钮!"
    
27. #027          Case 112
    
28. #028              MsgBox "你选择的是""记账""按钮!"
    
29. #029          Case 113
    
30. #030              MsgBox "你选择的是""结账""按钮!"
    
31. #031          Case 114
    
32. #032              MsgBox "你选择的是""资产负债表""按钮!"
    
33. #033          Case 115
    
34. #034              MsgBox "你选择的是""损益表""按钮!"
    
35. #035          Case Else
    
36. #036              MsgProcess = CallWindowProc(PreWinProc, hwnd, Msg, wParam, lParam)
    
37. #037      End Select
    
38. #038  End Function

复制代码

代码解析：
       第1行到第13行代码，API函数声明。
       第14行到第36行代码，MsgProcess函数过程，根据参数wParam的值为窗体中的菜单指定所执行的操作，为了演示方便只使用MsgBox函数显示一个消息框，在实际应用中可以为菜单写入代码或指定过程名称。
       运行窗体后在窗体上添加菜单，如图所示。
      

入孝出悌

原帖由 yuanzhuping 于 2009-5-8 09:52 发表

DTP控件没正确注册？窗体中有个时间日期控件，请参阅http://club.excelhome.net/viewth ... ;page=73#pid2705819

按照你的帖子说明，我在控件工具箱中，没有找到这个DTP控件，重新安装office2003后也没有。不知道改怎么获得？

newvba

太佩服了！明天开始收藏。。。。

入孝出悌

原帖由 入孝出悌 于 2009-5-10 13:16 发表

按照你的帖子说明，我在控件工具箱中，没有找到这个DTP控件，重新安装office2003后也没有。不知道改怎么获得？

已经在坛子里面下载，谢谢

入孝出悌

第一百页第一贴留念

[ 本帖最后由 入孝出悌 于 2009-5-11 19:30 编辑 ]

ayu330602

老师在948楼介绍的无框窗体,实际上有一白边,上次看到有位老师的例题是完全没边的,不知老师有代码?
谢谢!

lsdij

好贴 楼主好人啊

yuanzhuping

技巧149         在用户窗体上添加工具栏
       在技巧148 中我们在用户窗体上使用API函数添加了菜单，还可以在用户窗体上继续添加工具栏用以显示一列下拉菜单的位图按钮，单击一个工具栏按钮等于选择一个菜单命令，以提供对常用功能和命令的快速访问。
       在用户窗体上添加工具栏可以使用Toolbar控件，在设计模式下右键单击“工具箱”，在显示的右键菜单中选择“附加控件”，在显示的对话框中选择“Microsoft Toolbar Control， veision 6.0”控件，在用户窗体上添加一个Toolbar控件。如图所示。
      
       因为需要在Toolbar控件按钮中使用图标，所以还需要在用户窗体中添加一个ImageList控件保存所需要的图像文件，在ImageList控件的属性页中插入6张图片，如图所示。
      
       用户窗体上添加了Toolbar控件后还需要设置其属性和添加按钮控件，可以在Toolbar控件的属性页中进行设置和添加，如所图示。
      
       还可以在代码运行时对其进行设置和添加按钮，双击用户窗体写入下面的代码：

1. #001  Private Sub UserForm_Initialize()
   
2. #002      ……使用API函数添加菜单代码略，详见附件
   
3. #003      Dim arr As Variant
   
4. #004      Dim i As Byte
   
5. #005      arr = Array(" 录入 ", " 审核", " 记账 ", " 结账 ", "负债表", "损益表")
   
6. #006      With Toolbar1
   
7. #007          .ImageList = ImageList1
   
8. #008          .Appearance = ccFlat
   
9. #009          .BorderStyle = ccNone
   
10. #010          .TextAlignment = tbrTextAlignBottom
    
11. #011          With .Buttons
    
12. #012              .Add(1, , "").Style = tbrPlaceholder
    
13. #013              For i = 0 To UBound(arr)
    
14. #014                  .Add(i + 2, , , , i + 1).Caption = arr(i)
    
15. #015              Next
    
16. #016          End With
    
17. #017      End With
    
18. #018  End Sub

复制代码

代码解析：
       第5行代码数组arr用来保存按钮的标题文字。
       第7行代码建立Toolbar控件和ImageList控件的关联。
       第8行代码设置Toolbar控件的外观效果，Appearance属性获得或设置控件的外观效果，设置值如表格所示。
      
       第9行代码设置Toolbar控件的边界样式，BorderStyle属性获得或设置边界样式，设置值如表格所示。
      
       第10行代码设置按钮文本显示在按钮图像下方，TextAlignment属性获得或设置一个值，决定按钮文本显示在按钮图像下方还是右侧，设置值如表格所示。
      
       第11行到第15行代码在Toolbar控件中添加按钮，添加按钮需要在Buttons的集合对象中使用Add方法，语法如下：
       object.Buttons.Add(index, key, caption, style, image)
       参数object是必需的，代表Toolbar对象。
      参数index是可选的，指定新增按钮的索引值，该索引值决定了按钮在Toolbar控件中的位置。如果省略index参数新增按钮添加到Butons集合的最后。
       参数key是可选的，指定新增按钮的关键字。
       参数caption是可选的，指定新增按钮的标题文本。
       参数style是可选的，指定新增按钮的Style属性，设置值如表格所示。
      
       参数image是可选的，指定新增按钮载入的图像，图像必须是与该Toolbar控件相关联的ImageList控件图像库中的一个。image参数可以是一个整数，对应ImageList图像库中某个图片的Index值也可以是一个字符串，对应图片的关键字Key。
       第12行代码代码首先在Toolbar控件中添加占位按钮，设置其style属性为tbrPlaceholder，添加的就是占位按钮，在Toolbar控件中是不显示的，仅仅起到占位的作用。
       第14行代码在占位按钮后继续添加6个按钮，设置其标题文本和图像在ImageList控件中的编号。
       为了响应Toolbar控件，双击Toolbar控件写入下面的代码：

1. #001  Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
   
2. #002      Select Case Button.Index
   
3. #003          Case 2
   
4. #004              MsgBox "录入"
   
5. #005          Case 3
   
6. #006              MsgBox "审核"
   
7. #007          Case 4
   
8. #008              MsgBox "记账"
   
9. #009          Case 5
   
10. #010              MsgBox "结账"
    
11. #011          Case 6
    
12. #012              MsgBox "资产负债表"
    
13. #013          Case 7
    
14. #014              MsgBox "损益表"
    
15. #015      End Select
    
16. #016  End Sub

复制代码

代码解析：
       Toolbar控件的ButtonClick事件，在单击Toolbar控件的按钮时发生，参数Button代表单击的按钮。为了演示方便，根据其Index属性值使用消息框显示按钮标题文本，在实际应用中可以为菜单写入代码或指定过程名称。
       运行窗体后在窗体上添加工具栏，如图所示。
      

[ 本帖最后由 yuanzhuping 于 2009-5-11 15:26 编辑 ]

hesilent

感谢版主无私的奉献！