有时候,我们可能相在用户窗体标题栏添加最大化和最小化按钮,以方便对用户窗体的操控。下面是我找到的一段实现此功能的VBA代码,供大家需要时调用。
#If Win64 Then
Private Declare PtrSafeFunction GetWindowLongPtr _
Lib 'user32.dll'Alias 'GetWindowLongPtrA' ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long) AsLongPtr
Private Declare PtrSafeFunction SetWindowLongPtr _
Lib 'user32.dll'Alias 'SetWindowLongPtrA' ( _
ByVal hwnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr)As LongPtr
Private Declare PtrSafeFunction FindWindowA _
Lib 'user32.dll'( _
ByVal lpClassName AsString, _
ByVal lpWindowName AsString) As LongPtr
Private Declare PtrSafeFunction DrawMenuBar _
Lib 'user32.dll'( _
ByVal hwnd As LongPtr) AsLong
#Else
Private Declare FunctionGetWindowLongPtr _
Lib 'user32.dll'Alias 'GetWindowLongA' ( _
ByVal hwnd As Long, _
ByVal nIndex As Long) AsLong
Private Declare FunctionSetWindowLongPtr _
Lib 'user32.dll'Alias 'SetWindowLongA' ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare FunctionFindWindowA _
Lib 'user32.dll'( _
ByVal lpClassName AsString, _
ByVal lpWindowName AsString) As Long
Private Declare FunctionDrawMenuBar _
Lib 'user32.dll'( _
ByVal hwnd As Long) As Long
#End If
Private Sub UserForm_Initialize()
CreateMenu
End Sub
Private Sub CreateMenu()
Const GWL_STYLE As Long = -16
Const WS_SYSMENU As Long =&H80000
Const WS_MINIMIZEBOX As Long =&H20000
Const WS_MAXIMIZEBOX As Long =&H10000
#If Win64 Then
Dim lngFrmWndHdl As LongPtr
Dim lngStyle As LongPtr
#Else
Dim lngFrmWndHdl As Long
Dim lngStyle As Long
#End If
lngFrmWndHdl =FindWindowA(vbNullString, Me.Caption)
lngStyle =GetWindowLongPtr(lngFrmWndHdl, GWL_STYLE)
lngStyle = lngStyle OrWS_SYSMENU 'AddSystemMenu
lngStyle = lngStyle OrWS_MINIMIZEBOX 'Add MinimizeBox
lngStyle = lngStyle Or WS_MAXIMIZEBOX 'Add MaximizeBox
SetWindowLongPtr lngFrmWndHdl,GWL_STYLE, lngStyle
DrawMenuBar lngFrmWndHdl
End Sub
将上述代码放置在用户窗体代码模块中,运行后的效果如下图所示:
联系客服