现在的位置: 首页 > 窗体增强 > 正文

VBA 窗体之工具栏式窗体(小标题窗体)

2014年05月25日 窗体增强 ⁄ 共 2764字 ⁄ 字号 暂无评论 ⁄ 阅读 1,596 次

注意: 本文适用于 Excel 2000 及其以后版本(包含 64 位 Office )

在 VBE 编辑器中,我们能看到很多的小标题栏窗体,这就是工具栏窗体,其实我们通过对VBA用户窗体的定制,也可以使VBA的用户窗体成为工具栏式窗体。本文就是运用API函数来定制 Office 中的用户窗体,使其成为工具栏窗体。

001

 

附件下载:

点击链接从百度网盘下载

操作如下:

  • 在Excel 的VBE窗口中插入一个用户窗体,将其命名为 frmTools。在用户窗体中添加两个按钮,然后再添加一个模块。在窗体和模块中添加后面所列代码。
  • 在工作薄中的任意工作表中添加一窗体按钮控件,将指定其 设置宏 为 btnToolsForm_Click。其供示范之用.

具体代码:

"ModToolsForm" 模块代码

Sub btnToolsForm_Click()
 frmTools.Show
End Sub

"frmTools" 窗体代码

Option Explicit
'***************************************
'---此模块演示了一个工具栏窗体---
'***************************************
'以下声明API函数
#If Win64 Then '64位
 Private Declare PtrSafe Function FindWindow _
     Lib "user32" _
     Alias "FindWindowA" ( _
         ByVal lpClassName As String, _
         ByVal lpWindowName As String) _
 As LongPtr
 Private Declare PtrSafe Function GetWindowLongPtr _
     Lib "user32" _
     Alias "GetWindowLongPtrA" ( _
         ByVal hwnd As LongPtr, _
         ByVal nIndex As Long) _
 As LongPtr
 Private Declare PtrSafe Function SetWindowLongPtr _
     Lib "user32" _
     Alias "SetWindowLongPtrA" ( _
         ByVal hwnd As LongPtr, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As LongPtr) _
 As LongPtr
 Private Declare PtrSafe Function DrawMenuBar _
     Lib "user32" ( _
         ByVal hwnd As LongPtr) _
 As Long
#Else '32位
 '查找窗口
 Private Declare Function FindWindow _
     Lib "User32" _
     Alias "FindWindowA" ( _
         ByVal lpClassName As String, _
         ByVal lpWindowName As String) _
 As Long
 '取得窗口样式位
 Private Declare Function GetWindowLong _
     Lib "User32" _
     Alias "GetWindowLongA" ( _
         ByVal Hwnd As Long, _
        ByVal nIndex As Long) _
 As Long
 '设置窗口样式位
 Private Declare Function SetWindowLong _
     Lib "User32" _
     Alias "SetWindowLongA" ( _
         ByVal Hwnd As Long, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long) _
 As Long
 '重绘窗体标题栏
 Private Declare Function DrawMenuBar _
      Lib "User32" ( _
        ByVal Hwnd As Long) _
 As Long
#End If
#If Win64 Then '64位
 Private FHwnd As LongPtr
 Private FIstype As LongPtr
#Else
 Private FHwnd As Long
 Private FIstype As Long
#End If
'以下定义常数
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_TOOLWINDOW = &H80&
 
 
'****************************************
'---主程序---
'****************************************
 
Private Sub btnClose_Click()
    Unload Me
End Sub
 
Private Sub btnReset_Click()
    #If Win64 Then '64位
        '取得拓展窗口样式位
        FIstype = GetWindowLongPtr(FHwnd, GWL_EXSTYLE)
        '拓展窗体样式位: 原样式无工具栏窗口样式
        FIstype = FIstype And Not WS_EX_TOOLWINDOW
        '重设拓展窗体样式位
        SetWindowLongPtr FHwnd, GWL_EXSTYLE, FIstype
        '重绘窗体标题栏
        DrawMenuBar FHwnd
    #Else
       '取得拓展窗口样式位
       FIstype = GetWindowLong(FHwnd, GWL_EXSTYLE)
       '拓展窗体样式位: 原样式无工具栏窗口样式
       FIstype = FIstype And Not WS_EX_TOOLWINDOW
       '重设拓展窗体样式位
       SetWindowLong FHwnd, GWL_EXSTYLE, FIstype
       '重绘窗体标题栏
       DrawMenuBar FHwnd
    #End If
End Sub
 
Private Sub UserForm_Initialize()
    #If Win64 Then '64位
        '查找本窗口句柄
        FHwnd = FindWindow("ThunderDFrame", Me.Caption)
        '取得拓展窗口样式位
        FIstype = GetWindowLongPtr(FHwnd, GWL_EXSTYLE)
        '拓展窗体样式位: 原样式和工具栏窗口样式
        FIstype = FIstype Or WS_EX_TOOLWINDOW
        '重设拓展窗体样式位
        SetWindowLongPtr FHwnd, GWL_EXSTYLE, FIstype
        '重绘窗体标题栏
        DrawMenuBar FHwnd
    #Else
        '查找本窗口句柄
        FHwnd = FindWindow("ThunderDFrame", Me.Caption)
        '取得拓展窗口样式位
        FIstype = GetWindowLong(FHwnd, GWL_EXSTYLE)
        '拓展窗体样式位: 原样式和工具栏窗口样式
        FIstype = FIstype Or WS_EX_TOOLWINDOW
        '重设拓展窗体样式位
        SetWindowLong FHwnd, GWL_EXSTYLE, FIstype
        '重绘窗体标题栏
        DrawMenuBar FHwnd
    #End If
End Sub

给我留言

您必须 [ 登录 ] 才能发表留言!