Excel窗体API应用技巧

Excel窗体API应用技巧

这里将收集一些使用API函数增强Excel窗体的例子。

首先，这里是需要用的API函数和常数。复制代码到一个标准模块中。

' API函数Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPublic Declare Function ShowWindow Lib "user32" ( _ByVal hwnd As Long, _ByVal nCmdShow As Long) As LongPublic Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _ByVal hwnd As Long, _ByVal nIndex As Long) As LongPublic Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _ByVal hwnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongPublic Declare Function SetWindowPos Lib "user32" ( _ByVal hwnd As Long, _ByVal hWndInsertAfter As Long, _ByVal x As Long, _ByVal y As Long, _ByVal cx As Long, _ByVal cy As Long, _ByVal wFlags As Long) As LongPublic Declare Function SetLayeredWindowAttributes Lib "user32" ( _ByVal hwnd As Long, _ByVal crKey As Long, _ByVal bAlpha As Byte, _ByVal dwFlags As Long) As LongPublic Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As LongPublic Declare Function GetMenuItemCount Lib "user32" (ByVal hmenu As Long) As LongPublic Declare Function RemoveMenu Lib "user32" ( _ByVal hmenu As Long, _ByVal nPosition As Long, _ByVal wFlags As Long) As LongPublic Declare Function DeleteMenu Lib "user32" ( _ByVal hmenu As Long, _ByVal nPosition As Long, _ByVal wFlags As Long) As LongPublic Declare Function GetSystemMenu Lib "user32" ( _ByVal hwnd As Long, _ByVal bRevert As Long) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ByVal hwnd As Long, _ByVal wMsg As Long, _ByVal wParam As Long, _lParam As Any) As LongPublic Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPublic Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPublic Declare Function AnimateWindow Lib "user32" ( _ByVal hwnd As Long, _ByVal dwTime As Long, _ByVal dwFlags As Long) As LongPublic Declare Function MoveWindow Lib "user32" ( _ByVal hwnd As Long, _ByVal x As Long, _ByVal y As Long, _ByVal nWidth As Long, _ByVal nHeight As Long, _ByVal bRepaint As Long) As LongPublic Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long ' API常量Public Const GWL_STYLE = (-16)Public Const GWL_EXSTYLE = (-20)  Public Const WS_MAXIMIZEBOX = &H10000Public Const WS_MINIMIZEBOX = &H20000Public Const WS_THICKFRAME = &H40000Public Const WS_EX_LAYERED = &H80000Public Const WS_SYSMENU = &H80000Public Const WS_CAPTION = &HC00000 Public Const SW_HIDE = 0Public Const SW_SHOWNORMAL = 1Public Const SW_SHOWMINIMIZED = 2Public Const SW_SHOWMAXIMIZED = 3 Public Const LWA_ALPHA = &H2 Public Const MF_BYCOMMAND = &H0Public Const MF_BYPOSITION = &H400&Public Const MF_DISABLED = &H2&Public Const MF_REMOVE = &H1000& Public Const SC_CLOSE = &HF060Public Const SC_MOVE = &HF010 Public Const WM_SYSCOMMAND = &H112 Public Const AW_ACTIVATE = &H20000Public Const AW_BLEND = &H80000 Public Enum ESetWindowPosStylesSWP_SHOWWINDOW = &H40SWP_HIDEWINDOW = &H80SWP_FRAMECHANGED = &H20SWP_NOACTIVATE = &H10SWP_NOCOPYBITS = &H100SWP_NOMOVE = &H2SWP_NOOWNERZORDER = &H200SWP_NOREDRAW = &H8SWP_NOREPOSITION = SWP_NOOWNERZORDERSWP_NOSIZE = &H1SWP_NOZORDER = &H4SWP_DRAWFRAME = SWP_FRAMECHANGEDHWND_TOPMOST = -1HWND_NOTOPMOST = -2End Enum Public Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd Type

1. 最大最小化按钮和可拉动边框
去除和恢复最大最小化按钮，以及实现可拉动边框调整窗体大小。

' 窗口句柄变量Dim hwnd As LongPrivate Sub cmdMax_Click()ShowWindow hwnd, SW_SHOWMAXIMIZEDEnd SubPrivate Sub cmdMin_Click()ShowWindow hwnd, SW_SHOWMINIMIZEDEnd SubPrivate Sub cmdNormal_Click()ShowWindow hwnd, SW_SHOWNORMALEnd Sub Private Sub cmdShow_Click()Dim lStyle As LongIf Left(cmdShow.Caption, 2) = "关闭" ThenlStyle = GetWindowLong(hwnd, GWL_STYLE)lStyle = lStyle And Not WS_THICKFRAMElStyle = lStyle And Not WS_MINIMIZEBOXlStyle = lStyle And Not WS_MAXIMIZEBOXcmdShow.Caption = "显示最大化最小化按钮"cmdMin.Enabled = FalseElselStyle = GetWindowLong(hwnd, GWL_STYLE)lStyle = lStyle Or WS_THICKFRAMElStyle = lStyle Or WS_MINIMIZEBOXlStyle = lStyle Or WS_MAXIMIZEBOXcmdShow.Caption = "关闭最大化最小化按钮"cmdMin.Enabled = TrueEnd IfSetWindowLong hwnd, GWL_STYLE, lStyleApplication.ScreenUpdating = FalseMe.HideMe.ShowApplication.ScreenUpdating = TrueEnd Sub' 显示窗体最大化、最小化按钮并使窗体边框可拉Private Sub UserForm_Initialize()Dim lStyle As Long' 获取窗体句柄    hwnd = FindWindow(vbNullString, Me.Caption)' 获取窗体风格    lStyle = GetWindowLong(hwnd, GWL_STYLE)lStyle = lStyle Or WS_THICKFRAME    ' 可拉动边框    lStyle = lStyle Or WS_MINIMIZEBOX   ' 最小化按钮    lStyle = lStyle Or WS_MAXIMIZEBOX   ' 最大化按钮    ' 设置窗体风格    SetWindowLong hwnd, GWL_STYLE, lStyleEnd Sub

2. 关闭按钮和菜单 - 示例一
三种不同的方法去除关闭按钮和系统菜单，还可以去除移动系统菜单使窗体不可移动。

Dim hwnd As Long' 使用SendMessage关闭窗体Private Sub CommandButton1_Click()SendMessage hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&End Sub' 使用Unload方法关闭窗体Private Sub CommandButton2_Click()Unload MeEnd Sub' 使用DeleteMenu方法删除关闭和移动按钮菜单，窗体不能关闭和移动Private Sub CommandButton3_Click()Dim hmenu As Long, lR As Long'取得系统菜单句柄    hmenu = GetSystemMenu(hwnd, 0)'删除关闭按钮和系统菜单    lR = DeleteMenu(hmenu, SC_CLOSE, MF_BYCOMMAND)'删除移动系统菜单    lR = DeleteMenu(hmenu, SC_MOVE, MF_BYCOMMAND)Me.HideMe.ShowEnd Sub ' 使用RemoveMenu方法删除关闭按钮菜单，窗体不能关闭Private Sub CommandButton4_Click()Dim hmenu     As LongDim nCount     As Long'取得系统菜单句柄    hmenu = GetSystemMenu(hwnd, 0)'删除关闭按钮和系统菜单    RemoveMenu hmenu, SC_CLOSE, MF_REMOVEMe.HideMe.ShowEnd Sub ' 使用RemoveMenu方法删除关闭按钮菜单，窗体不能关闭Private Sub CommandButton5_Click()Dim hmenu     As LongDim lTotal     As Long'取得系统菜单句柄    hmenu = GetSystemMenu(hwnd, 0)'取得菜单项个数    lTotal = GetMenuItemCount(hmenu)'删除最后一项关闭项    RemoveMenu hmenu, ltotoal - 1, MF_DISABLED Or MF_BYPOSITIONMe.HideMe.ShowEnd Sub Private Sub UserForm_Initialize()hwnd = FindWindow(vbNullString, Me.Caption)End Sub

3. 关闭按钮和菜单 - 示例二

Private hwnd As LongPrivate lStyle As Long' 另一种去除关闭按钮和菜单的方法Private Sub cmdRemove_Click()hwnd = FindWindow("ThunderDFrame", Me.Caption)lStyle = GetWindowLong(hwnd, GWL_STYLE)lStyle = lStyle And Not WS_SYSMENUSetWindowLong hwnd, GWL_STYLE, lStyleDrawMenuBar hwndcmdShow.Enabled = TruecmdRemove.Enabled = FalseEnd SubPrivate Sub cmdShow_Click()cmdShow.Enabled = FalsecmdRemove.Enabled = TrueSetWindowLong hwnd, GWL_STYLE, lStyle Or WS_SYSMENUDrawMenuBar hwndEnd SubPrivate Sub UserForm_Initialize()cmdRemove.Enabled = TruecmdShow.Enabled = FalseEnd Sub

4. 去除标题栏和边框

Dim hwnd As Long ' 控制标题栏和边框Private Function TitleBar(ByVal bState As Boolean)Dim lStyle As LongDim tR As RECT ' 获取窗体范围尺寸    GetWindowRect hwnd, tRlStyle = GetWindowLong(hwnd, GWL_STYLE)' 重设窗体风格    If (bState) ThenMe.Caption = "标题栏和边框示范"lStyle = lStyle Or WS_SYSMENUlStyle = lStyle Or WS_CAPTIONElseMe.Caption = ""lStyle = lStyle And Not WS_SYSMENUlStyle = lStyle And Not WS_CAPTIONEnd IfSetWindowLong hwnd, GWL_STYLE, lStyle ' 设定窗体位置，使无标题栏和边框的窗体尺寸与有标题栏和边框的窗体尺寸保持一致    SetWindowPos hwnd, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGEDEnd Function Private Sub CheckBox1_Click()If CheckBox1.Value = True ThenTitleBar False      ' 去除标题栏和边框    ElseTitleBar True       ' 恢复标题栏和边框    End IfEnd Sub Private Sub UserForm_Initialize()hwnd = FindWindow(vbNullString, Me.Caption)End Sub

5. 最上层显示
可以让窗体始终在最上层显示。

Dim hwnd As Long' 设置最上层显示Private Sub CommandButton1_Click()SetWindowPos hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZEEnd Sub' 解除最上层显示Private Sub CommandButton2_Click()SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZEEnd SubPrivate Sub UserForm_Initialize()hwnd = FindWindow(vbNullString, Me.Caption)End Sub

6. 透明窗体
设置窗体的透明度以及恢复正常显示。

Dim hwnd As LongDim lStyleOld As Long ' 设置窗体透明显示Private Sub CommandButton1_Click()Dim rtn As Long If IsNumeric(TextBox1.Text) = False ThenMsgBox "请输入0到255之间的数字", vbInformation, "错误"Exit SubEnd IfIf Val(TextBox1.Text) > 255 Or Val(TextBox1.Text) < 0 ThenMsgBox "请输入0到255之间的数字", vbInformation, "错误"Exit SubEnd If' 保存旧的窗体风格    lStyleOld = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = lStyleOld Or WS_EX_LAYEREDSetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, TextBox1.Text, LWA_ALPHAEnd Sub' 恢复窗体风格Private Sub CommandButton2_Click()SetWindowLong hwnd, GWL_EXSTYLE, lStyleOldEnd Sub Private Sub UserForm_Initialize()hwnd = FindWindow(vbNullString, Me.Caption)End Sub

7. 窗体开始画面
窗体以特效方式开始显示，可以用来做程序运行时的开始画面。

Dim hwnd As Long Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)Unload MeEnd Sub Private Sub UserForm_Initialize()Dim tR As RECTDim lStyle As Long hwnd = FindWindow(vbNullString, Me.Caption)' 获取客户区的尺寸    GetClientRect hwnd, tR' 获取风格    lStyle = GetWindowLong(hwnd, GWL_STYLE) ' 去除边框和标题栏    Me.Caption = ""lStyle = lStyle And Not WS_SYSMENUlStyle = lStyle And Not WS_CAPTION SetWindowLong hwnd, GWL_STYLE, lStyle ' 在屏幕中心显示窗体    MoveWindow hwnd, (GetSystemMetrics(0) - tR.Right + tR.Left) / 2, (GetSystemMetrics(1) - tR.Bottom + tR.Top) / 2, _tR.Right - tR.Left, tR.Bottom - tR.Top, False' 3秒钟内淡入方式显示窗体画面    AnimateWindow hwnd, 3000, AW_BLEND Or AW_ACTIVATE' 显示窗体后自动卸载窗体    Unload MeEnd Sub

当然这些窗体技巧偶尔为之尚可，滥用就不好了。

示范文件下载：SkyDrive