修改Excel用户窗体的窗口样式
首先看看下图：
这是一个用户窗体，看不出来吧，但确实是一个用户窗体。我们使用代码去除了它的最大化、最小化和关闭按钮并作了一些设置，使得它好像是一个浮动工具栏。下面程序中的SetUserformAppearance过程用于设置用户窗体的样式，可作为通用的程序调用。该过程能够独立设置：
- 窗体是否有标题栏
- 用作浮动工具栏时，标题栏是否为常规尺寸或小尺寸
- 是否可以改变窗体大小
- 窗体是否有最大化按钮
- 窗体是否有最小化按钮
- 窗体是否有关闭按钮
- 窗体是否有图标以及图标是否可用
（也可参考《Professional Excel Development》中的第10章）
在VBE中插入一个用户窗体，如上图所示，在其中放置一个标签并输入文本、放置一个按钮。
然后，插入一个标准模块，在其中输入下面的代码：
1: ‘ 说明: 修改用户窗体的窗口样式
2: Option Explicit
3:
4: ‘ Windows API声明和常量声明
5: Private Declare Function GetWindowLong Lib “user32″ Alias “GetWindowLongA” (ByVal hwnd As Long, ByVal nIndex As Long) As Long
6: Private Declare Function SetWindowLong Lib “user32″ Alias “SetWindowLongA” (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
7: Private Declare Function GetSystemMenu Lib “user32″ (ByVal hwnd As Long, ByVal bRevert As Long) As Long
8: Private Declare Function DeleteMenu Lib “user32″ (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
9: Private Declare Function DrawMenuBar Lib “user32″ (ByVal hwnd As Long) As Long
10:
11: Private Const GWL_STYLE As Long = (-16) ‘窗口样式偏移量
12: Private Const GWL_EXSTYLE As Long = (-20) ‘窗口扩展样式偏移量
13: Private Const WS_CAPTION As Long = &HC00000 ‘添加标题栏
14: Private Const WS_SYSMENU As Long = &H80000 ‘添加系统菜单
15: Private Const WS_THICKFRAME As Long = &H40000 ‘添加可调整的框架
16: Private Const WS_MINIMIZEBOX As Long = &H20000 ‘在标题栏中添加最小化框
17: Private Const WS_MAXIMIZEBOX As Long = &H10000 ‘在标题栏中添加最大化框
18: Private Const WS_EX_DLGMODALFRAME As Long = &H1 ‘控制是否窗口有图标
19: Private Const WS_EX_TOOLWINDOW As Long = &H80 ‘工具窗口:最小标题栏
20: Private Const SC_CLOSE As Long = &HF060 ‘关闭菜单项
21:
22: ‘用户窗体样式枚举列表
23: Public Enum UserformWindowStyles
24: uwsNoTitleBar = 0
25: uwsHasTitleBar = 1
26: uwsHasSmallTitleBar = 2
27: uwsHasMaxButton = 4
28: uwsHasMinButton = 8
29: uwsHasCloseButton = 16
30: uwsHasIcon = 32
31: uwsCanResize = 64
32: uwsDefault = uwsHasTitleBar Or uwsHasCloseButton
33: End Enum
34:
35: ‘ 说明: 设置用户窗体的窗口样式的程序
36: ‘
37: ‘ 参数: frmForm 要改变样式的用户窗体
38: ‘ lStyles 设置样式的枚举值,能够将枚举值添加在一起以设置多个样式
39: ‘ sIconPath 如果设置uwsHasIcon样式,那么这是用于窗体的图标文件的路径
40: ‘
41: Sub SetUserformAppearance(ByRef frmForm As Object, ByVal lStyles As UserformWindowStyles, Optional ByVal sIconPath As String)
42:
43: Dim sCaption As String
44: Dim hwnd As Long
45: Dim lStyle As Long
46: Dim hMenu As Long
47:
48: ‘查找窗体的窗口句柄
49: sCaption = frmForm.Caption
50: frmForm.Caption = “FindThis” & Rnd
51: hwnd = FindOurWindow(“ThunderDFrame”, frmForm.Caption)
52: frmForm.Caption = sCaption
53:
54: ‘如果要小的标题栏,不要图标,也不要最大化或最小化按钮
55: If lStyles And uwsHasSmallTitleBar Then
56: lStyles = lStyles And Not (uwsHasMaxButton Or uwsHasMinButton Or uwsHasIcon)
57: End If
58:
59: ‘获取正常的窗口样式位
60: lStyle = GetWindowLong(hwnd, GWL_STYLE)
61:
62: ‘适当地更新正常的样式位
63: ‘如果要图标或者最大化、最小化或关闭按钮,则必须有系统菜单
64: ModifyStyles lStyle, lStyles, uwsHasIcon Or uwsHasMaxButton Or uwsHasMinButton Or uwsHasCloseButton, WS_SYSMENU
65:
66: ‘大多数情况下需要标题栏!
67: ModifyStyles lStyle, lStyles, uwsHasIcon Or uwsHasMaxButton Or uwsHasMinButton Or uwsHasCloseButton Or uwsHasTitleBar Or uwsHasSmallTitleBar, WS_CAPTION
68:
69: ModifyStyles lStyle, lStyles, uwsHasMaxButton, WS_MAXIMIZEBOX
70: ModifyStyles lStyle, lStyles, uwsHasMinButton, WS_MINIMIZEBOX
71: ModifyStyles lStyle, lStyles, uwsCanResize, WS_THICKFRAME
72:
73: ‘使用正常样式位更新窗口
74: SetWindowLong hwnd, GWL_STYLE, lStyle
75:
76: ‘获取扩展的样式位
77: lStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
78:
79: ‘适当地修改
80: ModifyStyles lStyle, lStyles, uwsHasSmallTitleBar, WS_EX_TOOLWINDOW
81:
82: If lStyles And uwsHasIcon Then
83: lStyle = lStyle And Not WS_EX_DLGMODALFRAME
84:
85: ‘设置图标,如果有
86: SetIcon hwnd, sIconPath
87: Else
88: lStyle = lStyle Or WS_EX_DLGMODALFRAME
89:
90: ‘设置图标,如果有
91: SetIcon hwnd, “”
92: End If
93:
94: ‘使用扩展样式位更新窗口
95: SetWindowLong hwnd, GWL_EXSTYLE, lStyle
96:
97: ‘通过从控制菜单移除处理关闭按钮而不是通过窗口样式位
98: If lStyles And uwsHasCloseButton Then
99: ‘需要则重置控制菜单
100: hMenu = GetSystemMenu(hwnd, 1)
101: Else
102: ‘不需要则将其从控制菜单中删除
103: hMenu = GetSystemMenu(hwnd, 0)
104: DeleteMenu hMenu, SC_CLOSE, 0&
105: End If
106:
107: ‘刷新变化后的窗口
108: DrawMenuBar hwnd
109:
110: End Sub
111:
112: ‘ 说明: 检查是否样式位被设置和设置/清除了相应的窗口样式位
113: ‘
114: Private Sub ModifyStyles(ByRef lFormStyle As Long, ByVal lStyleSet As Long, ByVal lChoice As UserformWindowStyles, ByVal lWS_Style As Long)
115:
116: If lStyleSet And lChoice Then
117: lFormStyle = lFormStyle Or lWS_Style
118: Else
119: lFormStyle = lFormStyle And Not lWS_Style
120: End If
121:
122: End Sub
再插入一个标准模块，并输入下面的代码：
1: Option Explicit
2: Option Private Module
3:
4: ‘ 为ApphWnd和FindOurWindow示例函数的声明
5: ‘ 获取桌面窗口的句柄
6: Private Declare Function GetDesktopWindow Lib “user32″ () As Long
7:
8: ‘查找具有指定类名和标题的子窗口
9: Private Declare Function FindWindowEx Lib “user32″ Alias “FindWindowExA” (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
10:
11: ‘获取当前Excel实例的ID
12: Private Declare Function GetCurrentProcessId Lib “kernel32″ () As Long
13:
14: ‘获取正处理的窗口的ID
15: Private Declare Function GetWindowThreadProcessId Lib “user32″ (ByVal hwnd As Long, ByRef lpdwProcessId As Long) As Long
16:
17: ‘ 为WorkbookWindowhWnd示例函数的声明
18: ‘ WorkbookWindowhWnd过程使用上面定义的FindWindowEx
19: ‘ 为SetNameDropdownWidth示例函数的声明
20: ‘ 在SendMessage调用中使用的常量
21:
22: Private Const CB_SETDROPPEDWIDTH As Long = &H160& ‘winuser.h
23:
24: ‘ 函数声明
25: ‘ SetNameDropdownWidth过程也使用上面定义的FindWindowEx
26: ‘ 发送给窗口的消息
27: Private Declare Function SendMessage Lib “user32″ Alias “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
28:
29: ‘ 为SetIcon示例过程的声明
30: ‘ 用于SendMessage调用的常量
31: Private Const WM_SETICON As Long = &H80
32:
33: ‘ 函数声明
34: ‘ SetIcon过程也使用上面定义的SendMessage
35: ‘ 获取文件图标的句柄
36: Private Declare Function ExtractIcon Lib “shell32.dll” Alias “ExtractIconA” (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
37:
38: ‘ 查找Excel主窗口句柄
39: Function ApphWnd() As Long
40:
41: If Val(Application.Version) >= 10 Then
42: ApphWnd = Application.hwnd
43: Else
44: ApphWnd = FindOurWindow(“XLMAIN”, Application.Caption)
45: End If
46:
47: End Function
48:
49: ‘ 查找属于当前Excel实例的指定类和标题的顶层窗口
50: ‘ 参数: sClass 要查找的窗口类名
51: ‘ sCaption 要查找的窗口标题
52: Function FindOurWindow(Optional ByVal sClass As String = vbNullString, Optional ByVal sCaption As String = vbNullString)
53:
54: Dim hWndDesktop As Long
55: Dim hwnd As Long
56: Dim hProcThis As Long
57: Dim hProcWindow As Long
58:
59: ‘所有顶层窗口都是桌面的子窗口,因此首先获取句柄
60: hWndDesktop = GetDesktopWindow
61:
62: ‘获取与Excel实例匹配的ID
63: hProcThis = GetCurrentProcessId
64:
65: Do
66: ‘查找与指定窗口类和/或标题匹配的桌面的下一个子窗口
67: ‘开始时hWnd是零,因此将获取第一个匹配窗口
68: ‘每次调用将传递上次找到的窗口句柄,从而获得下一个
69: hwnd = FindWindowEx(hWndDesktop, hwnd, sClass, sCaption)
70:
71: ‘获得拥有查找窗口的处理过程ID
72: GetWindowThreadProcessId hwnd, hProcWindow
73:
74: ‘循环直到窗口的处理过程与该过程匹配或者没有找到窗口
75: Loop Until hProcWindow = hProcThis Or hwnd = 0
76:
77: ‘返回找到的句柄
78: FindOurWindow = hwnd
79:
80: End Function
81:
82: ‘ 设置窗口的图标
83: ‘ 参数: hwnd 要修改图标的窗口的句柄
84: ‘ sIcon 图标文件的路径
85: Sub SetIcon(ByVal hwnd As Long, ByVal sIcon As String)
86:
87: Dim hIcon As Long
88:
89: ‘获取图标句柄
90: hIcon = ExtractIcon(0, sIcon, 0)
91:
92: ‘设置大(32×32)和小(16×16)图标
93: SendMessage hwnd, WM_SETICON, True, hIcon
94: SendMessage hwnd, WM_SETICON, False, hIcon
95:
96: End Sub
在用户窗体模块的Initialize事件中，调用上面的SetUserformAppearance过程，同时在QueryClose事件中，放置下列代码以阻止使用Alt+F4组合键关闭用户窗体：
1: Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
2:
3: Cancel = (CloseMode = vbFormControlMenu)
4:
5: End Sub
