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

Office Excel VBA 窗体之去除窗体标题栏 实现代码

附件下载:

点击链接从百度网盘下载

操作如下:

◾在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

发表评论

您的电子邮箱地址不会被公开。 必填项已用*标注