在使用vba设计用户窗体时,通常会将其设定为固定的尺寸。然而,通过编程技巧,可以实现类似于调整大小功能的效果。
本文的代码来自exceloffthegrid.com,供有兴趣的读者参考。
本文的代码可以实现以下功能:允许调整用户窗体的大小;在调整窗体大小时,用户窗体的Resize事件会被触发;每次Resize事件后,对象的大小或位置都会随之改变。
首先,在VBE中添加一个标准模块,并输入以下代码:
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
Public Const WS_THICKFRAME = &H40000
#If VBA7 Then
Public Declare PtrSafe Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#Else
Public Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
#End If
Sub ResizeWindowSettings(frm As Object, show As Boolean)
Dim windowStyle As Long
Dim windowHandle As Long
'获取Windows内存中对窗口和样式位置的引用
windowHandle = FindWindowA(vbNullString, frm.Caption)
windowStyle = GetWindowLong(windowHandle, GWL_STYLE)
'确定要应用的样式
If show = False Then
windowStyle = windowStyle And (Not WS_THICKFRAME)
Else
windowStyle = windowStyle + (WS_THICKFRAME)
End If
'应用新样式
SetWindowLong windowHandle, GWL_STYLE, windowStyle
'使用新样式重新创建用户窗体窗口
DrawMenuBar windowHandle
End Sub上述代码段创建了一个可重用的过程,用于开启或关闭用户窗体的调整大小设置。如果想要启用调整用户窗体大小的功能,可以使用以下代码:
Call ResizeWindowSettings(myUserForm, True)
如果想要关闭调整用户窗体大小的功能,可以使用以下代码:
Call ResizeWindowSettings(myUserForm, False)
其中,myUserForm是需要调整大小的用户窗体的名称。
示例
在VBE中,插入一个用户窗体,如下图1所示。
乐彼多用户商城系统,采用ASP.NET分层技术和AJAX技术,运营于高速稳定的微软.NET+MSSQL 2005平台;完全具备搭建超大型网络购物多用户网上商城的整体技术框架和应用层次LBMall 秉承乐彼软件优秀品质,后台人性化设计,管理窗口识别客户端分辨率自动调整,独立配置的菜单操作锁,使管理操作简单便捷。待办事项1、新订单、支付、付款、短信提醒2、每5分钟自动读取3、新事项声音提醒 店铺管理1
图1
可以看到,该用户窗体上包含一个名为“lstListBOx”的列表框和一个名为“cmdClose”的命令按钮。
当调整该用户窗体大小时,这两个元素应该相应地进行调整。lstListBox的大小应改变,但位置不应改变,而cmdClose的位置应改变,但大小不应改变。为此,需要从该用户窗体的底部和右侧了解这些对象的位置。如果与底部和右侧保持相同的距离,则这些元素看起来像是与该用户窗体同步移动。
在该用户窗体的代码窗口中,输入以下代码:
Private lstListBoxBottom As Double Private lstListBoxRight As Double Private cmdCloseBottom As Double Private cmdCloseRight As Double Private Sub UserForm_Initialize() '调用Window API启用调整大小 Call ResizeWindowSettings(Me, True) '获取要调整大小的对象的右下角定位点位置 lstListBoxBottom = Me.Height - lstListBox.Top - lstListBox.Height lstListBoxRight = Me.Width - lstListBox.Left - lstListBox.Width cmdCloseBottom = Me.Height - cmdClose.Top - cmdClose.Height cmdCloseRight = Me.Width - cmdClose.Left - cmdClose.Width End Sub Private Sub UserForm_Resize() On Error Resume Next '设置对象的新位置 lstListBox.Height = Me.Height - lstListBoxBottom - lstListBox.Top lstListBox.Width = Me.Width - lstListBoxRight - lstListBox.Left cmdClose.Top = Me.Height - cmdCloseBottom - cmdClose.Height cmdClose.Left = Me.Width - cmdCloseRight - cmdClose.Width On Error GoTo 0 End Sub
运行用户窗体,效果如下图2所示。
图2
欢迎在评论区留言,帮助完善本文内容,让更多人能够学习到更完善的知识。









