VBA常用技巧代码解析

pengeb · 发表于 2009-5-10 00:40

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

yuanzhuping · 发表于 2009-5-10 10:09

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

#001 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#002 Private Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
#003 Private Declare Function CreateMenu Lib "user32" () As Long
#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
#005 Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
#006 Private Declare Function CreatePopupMenu Lib "user32" () As Long
#007 Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#008 Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
#009 Private Const GWL_WNDPROC = (-4)
#010 Private Const MF_STRING = &H0&
#011 Private Const MF_POPUP = &H10&
#012 Private Const MF_SEPARATOR = &H800&
#013 Dim MenuWnd As Long, Dump As Long, PopupMenuID As Long, PopupMenuWnd As Long, MenuID As Long
#014 Private Sub UserForm_Initialize()
#015 If Val(Application.Version) < 9 Then
#016 hwnd = FindWindow("ThunderXFrame", Me.Caption)
#017 Else
#018 hwnd = FindWindow("ThunderDFrame", Me.Caption)
#019 End If
#020 MenuWnd = CreateMenu()
#021 PopupMenuID = CreatePopupMenu()
#022 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "系统设置(&X)")
#023 Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "保存(&S)...")
#024 Dump = AppendMenu(PopupMenuID, MF_STRING, 101, "备份(&E)")
#025 Dump = AppendMenu(PopupMenuID, MF_STRING, 102, "退出(&X)")
#026 PopupMenuID = CreatePopupMenu()
#027 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计凭证(&P)")
#028 Dump = AppendMenu(PopupMenuID, MF_STRING, 110, "录入(&L)")
#029 Dump = AppendMenu(PopupMenuID, MF_STRING, 111, "审核(&C)")
#030 PopupMenuID = CreatePopupMenu()
#031 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计账簿(&Z)")
#032 Dump = AppendMenu(PopupMenuID, MF_STRING, 112, "记账(&T)")
#033 Dump = AppendMenu(PopupMenuID, MF_STRING, 113, "结账(&J)")
#034 PopupMenuID = CreatePopupMenu()
#035 Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "会计报表(&B)")
#036 Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "资产负债表(&F)")
#037 Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "损益表(&Y)")
#038 Dump = SetMenu(hwnd, MenuWnd)
#039 PreWinProc = GetWindowLong(hwnd, GWL_WNDPROC)
#040 SetWindowLong hwnd, GWL_WNDPROC, AddressOf MsgProcess
#041 End Sub
#042 Private Sub UserForm_Terminate()
#043 DestroyMenu MenuWnd
#044 DestroyMenu PopupMenuID
#045 DestroyMenu PopupMenuWnd
#046 SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
#047 End Sub

复制代码

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

#001 Public PreWinProc As Long, hwnd As Long
#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
#003 Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
#004 Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
#005 Public Const MF_UNCHECKED = &H0&
#006 Public Const MF_CHECKED = &H8&
#007 Public Const MF_DISABLED = &H2&
#008 Public Const MF_GRAYED = &H1&
#009 Public Const MF_ENABLED = &H0&
#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
#011 Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
#012 Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
#013 Private Const MF_BYCOMMAND = &H0&
#014 Public Function MsgProcess(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#015 Dim SubMenu_hWnd As Long
#016 Select Case wParam
#017 Case 100
#018 MsgBox "你选择的是""保存""按钮!"
#019 Case 101
#020 MsgBox "你选择的是""备份""按钮!"
#021 Case 102
#022 Unload UserForm1
#023 Case 110
#024 MsgBox "你选择的是""录入""按钮!"
#025 Case 111
#026 MsgBox "你选择的是""审核""按钮!"
#027 Case 112
#028 MsgBox "你选择的是""记账""按钮!"
#029 Case 113
#030 MsgBox "你选择的是""结账""按钮!"
#031 Case 114
#032 MsgBox "你选择的是""资产负债表""按钮!"
#033 Case 115
#034 MsgBox "你选择的是""损益表""按钮!"
#035 Case Else
#036 MsgProcess = CallWindowProc(PreWinProc, hwnd, Msg, wParam, lParam)
#037 End Select
#038 End Function

复制代码

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

入孝出悌 · 发表于 2009-5-10 13:16

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

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

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

newvba · 发表于 2009-5-10 22:39

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

入孝出悌 · 发表于 2009-5-10 22:43

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

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

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

入孝出悌 · 发表于 2009-5-10 22:44

第一百页第一贴留念

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

ayu330602 · 发表于 2009-5-11 01:10

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

lsdij · 发表于 2009-5-11 10:39

好贴楼主好人啊

yuanzhuping · 发表于 2009-5-11 11:30

技巧149 在用户窗体上添加工具栏
   在技巧148 中我们在用户窗体上使用API函数添加了菜单，还可以在用户窗体上继续添加工具栏用以显示一列下拉菜单的位图按钮，单击一个工具栏按钮等于选择一个菜单命令，以提供对常用功能和命令的快速访问。
   在用户窗体上添加工具栏可以使用Toolbar控件，在设计模式下右键单击“工具箱”，在显示的右键菜单中选择“附加控件”，在显示的对话框中选择“Microsoft Toolbar Control， veision 6.0”控件，在用户窗体上添加一个Toolbar控件。如图所示。

因为需要在Toolbar控件按钮中使用图标，所以还需要在用户窗体中添加一个ImageList控件保存所需要的图像文件，在ImageList控件的属性页中插入6张图片，如图所示。

用户窗体上添加了Toolbar控件后还需要设置其属性和添加按钮控件，可以在Toolbar控件的属性页中进行设置和添加，如所图示。

还可以在代码运行时对其进行设置和添加按钮，双击用户窗体写入下面的代码：

#001 Private Sub UserForm_Initialize()
#002 ……使用API函数添加菜单代码略，详见附件
#003 Dim arr As Variant
#004 Dim i As Byte
#005 arr = Array(" 录入 ", " 审核", " 记账 ", " 结账 ", "负债表", "损益表")
#006 With Toolbar1
#007 .ImageList = ImageList1
#008 .Appearance = ccFlat
#009 .BorderStyle = ccNone
#010 .TextAlignment = tbrTextAlignBottom
#011 With .Buttons
#012 .Add(1, , "").Style = tbrPlaceholder
#013 For i = 0 To UBound(arr)
#014 .Add(i + 2, , , , i + 1).Caption = arr(i)
#015 Next
#016 End With
#017 End With
#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控件写入下面的代码：

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

复制代码

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

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

hesilent · 发表于 2009-5-11 12:50

感谢版主无私的奉献！

		自动登录	找回密码
密码			免费注册

VBA常用技巧代码解析

第8部分控件与用户窗体

佩服

第8部分控件与用户窗体

VBA常用技巧代码解析

第8部分 控件与用户窗体

佩服

第8部分 控件与用户窗体

第8部分控件与用户窗体

第8部分控件与用户窗体