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

VBA 窗体之去除窗体标题栏

2014年06月09日 窗体增强 ⁄ 共 2785字 ⁄ 字号 暂无评论 ⁄ 阅读 6,140 次
注意: 本文适用于 Excel 2000 及其以后版本(包含 64 位 Office )

 

在 VBA 中当我们有时需要显示一个无标题栏的窗体作为启动的界面,但是 VBA 的窗体不可以直接设置这样的属性,只有通过代码来实现

001

 

 

附件下载:

点击链接从百度网盘下载

 

操作如下:

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

 

具体代码:

"mdNoTitle" 模块代码

Sub ShowForm()
    DelTitleForm.Show
End Sub

"DelTitleForm" 窗体代码

'********************************
'---此模块演示怎样删除窗体标题栏---
'********************************
'以下声明API函数
#If Win64 Then '64位
    '取得窗体样式位
    Private Declare PtrSafe Function GetWindowLong _
        Lib "user32" _
        Alias "GetWindowLongPtrA" ( _
            ByVal Hwnd As LongPtr, _
            ByVal nIndex As Long) _
    As LongPtr
    '查找窗口
    Private Declare PtrSafe Function FindWindow _
        Lib "user32" _
        Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) _
    As LongPtr
    '设置窗体样式位
    Private Declare PtrSafe Function SetWindowLong _
        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
    '视情况向和窗体发送消息
    Private Declare PtrSafe Function SendMessage _
        Lib "user32" _
        Alias "SendMessageA" ( _
            ByVal Hwnd As LongPtr, _
            ByVal wMsg As Long, _
            ByVal wParam As LongPtr, _
            lParam As Any) _
    As LongPtr
    '释放鼠标
    Private Declare PtrSafe Function ReleaseCapture _
        Lib "user32" () _
    As Long
#Else
    '取得窗体样式位
    Private Declare Function GetWindowLong _
        Lib "user32" _
        Alias "GetWindowLongA" ( _
            ByVal hwnd As Long, _
            ByVal nIndex As Long) _
    As Long
    '查找窗口
    Private Declare Function FindWindow _
        Lib "user32" _
        Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) _
    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
    '视情况向窗体发送消息
    Private Declare Function SendMessage _
        Lib "user32" _
        Alias "SendMessageA" ( _
            ByVal hwnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Long, _
            lParam As Any) _
    As Long
    '释放鼠标控制
    Private Declare Function ReleaseCapture _
        Lib "user32" () _
    As Long
#End If
#If Win64 Then '64位
    Private hWndForm As LongPtr
    Private FIstype As LongPtr
#Else
    Private hWndForm As Long
    Private FIstype As Long
#End If
'以下定义常数和变量
Private Const GWL_STYLE = (-16) '窗口样式
Private Const WS_CAPTION = &HC00000
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE_MOUSE = &HF012&
'---关闭按钮---
Private Sub BtCancel_Click()
    Unload Me
End Sub
'---窗体双击---
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Unload Me
End Sub
'---窗体初始化---
Private Sub UserForm_Initialize()
    On Error Resume Next
    '查找窗体句柄
    hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    '取得窗体样式
    FIstype = GetWindowLong(hWndForm, GWL_STYLE)
    '窗体样式:原样式无标题
    FIstype = FIstype And Not WS_CAPTION
    '重设窗体样式
    SetWindowLong hWndForm, GWL_STYLE, FIstype
    '重绘窗体标题栏
    DrawMenuBar hWndForm
End Sub
'---鼠标按下---
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
ByVal X As Single, ByVal Y As Single)
    '释放控制
    ReleaseCapture
    '向窗体发送消息
    SendMessage hWndForm, WM_SYSCOMMAND, SC_MOVE_MOUSE, 0
End Sub

 

给我留言

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