VBA：创建可调整大小的用户窗体

完美Excel · 公众号 · Excel · 2024-09-18 06:20

正文

学习Excel技术，关注微信公众号：

excelperfect

标签：VBA，用户窗体

使用VBA，能够通过拖动用户窗体右下角或边框来放大或缩小用户窗体。如下图1所示。

图1

在VBE中，插入一个类模块，将其重命名为clUserFormResizer的类模块，并在其中输入下面的代码：

Private WithEvents frmResizableForm As MSForms.UserFormPrivate oResizableForm As ObjectPrivate WithEvents frResizerCorner As MSForms.FramePrivate WithEvents frResizerRight As MSForms.FramePrivate WithEvents frResizerBottom As MSForms.FramePrivate sngMinHeight As SinglePrivate sngMinWidth As SinglePrivate sngMouseX As SinglePrivate sngMouseY As SingleEvent Resizing(ByVal X As Single, ByVal Y As Single)Friend Property  Set ResizableForm(ByRef oFrm As Object)  Set frmResizableForm = oFrm  Set oResizableForm = oFrm   If sngMinHeight = 0 Or sngMinHeight > oResizableForm.Height Then    sngMinHeight = oResizableForm.Height  End If  If sngMinWidth = 0 Or sngMinWidth > oResizableForm.Width Then    sngMinWidth = oResizableForm.Width  End If  AddResizeControlsEnd PropertyFriend Property  Let MinHeight(sngValue As Single)  If oResizableForm Is Nothing Then    sngMinHeight = sngValue  ElseIf sngValue = 0 Or sngValue > oResizableForm.Height Then    sngMinHeight = oResizableForm.Height  Else    sngMinHeight = sngValue  End IfEnd PropertyFriend Property  Let MinWidth(sngValue As Single)  If oResizableForm Is Nothing Then    sngMinWidth = sngValue  ElseIf sngValue = 0 Or sngValue > oResizableForm.Width Then    sngMinWidth = oResizableForm.Width  Else    sngMinWidth = sngValue  End IfEnd PropertyPrivate Sub AddResizeControls()  Set frResizerCorner = oResizableForm.Controls.Add("Forms.Frame.1")  With frResizerCorner    .SpecialEffect = fmSpecialEffectFlat    .MousePointer = fmMousePointerSizeNWSE    .ZOrder 0    .Width = 15    .Height = 15  End With  With frResizerCorner.Add("Forms.label.1")    With .Font      .Name = "Marlett"      .Charset = 2      .Size = 14      .Bold = True    End With    .Caption = "o"    .ForeColor = 6579300    .Width = 14    .Height = 14    .Top = 1    .Left = 1    .Enabled = False  End With  Set frResizerRight = oResizableForm.Controls.Add("Forms.Frame.1")  With frResizerRight    .SpecialEffect = fmSpecialEffectFlat    .MousePointer = fmMousePointerSizeWE    .ZOrder 0    .Width = 2    .Top = 0  End With  Set frResizerBottom = oResizableForm.Controls.Add("Forms.Frame.1")  With frResizerBottom    .SpecialEffect = fmSpecialEffectFlat    .MousePointer = fmMousePointerSizeNS    .ZOrder 0    .Height = 2    .Left = 0  End WithEnd SubPrivate Sub frResizerCorner_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  If Button = 1 Then    sngMouseX = X    sngMouseY = Y  End IfEnd SubPrivate Sub frResizerCorner_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  If Button = 1 Then    With oResizableForm      If .Width + X - sngMouseX > sngMinWidth Then        .Width = .Width + X - sngMouseX      Else        X = 0        sngMouseX = 0      End If      If .Height + Y - sngMouseY > sngMinHeight Then        .Height = .Height + Y - sngMouseY      Else        Y = 0        sngMouseY = 0      End If    End With    If X <> 0 Or Y <> 0 Then      RaiseEvent Resizing(X - sngMouseX, Y - sngMouseY)    End If  End IfEnd SubPrivate Sub frResizerRight_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  If Button = 1 Then    With oResizableForm      If .Width + X > sngMinWidth Then        .Width = .Width + X        RaiseEvent Resizing(X, 0)      End If    End With  End IfEnd SubPrivate Sub frResizerBottom_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  If Button = 1 Then    With oResizableForm      If .Height + Y > sngMinHeight Then        .Height = .Height + Y        RaiseEvent Resizing(0, Y)      End If    End With  End IfEnd SubPrivate Sub frmResizableForm_Layout()  With frResizerCorner    .Left = oResizableForm.InsideWidth - .Width    .Top = oResizableForm.InsideHeight - .Height  End With  With frResizerRight    .Left = oResizableForm.InsideWidth - .Width    .Height = frResizerCorner.Top  End With  With frResizerBottom    .Top = oResizableForm.InsideHeight - .Height    .Width = frResizerCorner.Left  End WithEnd Sub

这个类模块必须与用户窗体一起才能调整大小。在用户窗体代码模块顶部添加一个变量，并在UserForm_Initialize事件中添加2行代码：

Private WithEvents oFormResize As clUserFormResizerPrivate Sub UserForm_Initialize() Set oFormResize = New clUserFormResizer Set oFormResize.ResizableForm = MeEnd Sub

但仅仅改变用户窗体的大小显然不够，用户窗体上其他控件也必须随之改变大小和/或随之移动。对于一个只有列表框和关闭按钮的简单用户窗体，这段代码非常简单：

Private Sub oFormResize_Resizing(ByVal X As Single, ByVal Y As Single)  With btnClose    .Left = .Left + X    .Top = .Top + Y  End With  With ListBox1    .Width = .Width + X    .Height = .Height + Y  End WithEnd Sub

根据计算机和图形卡的不同，在调整大小时，用户窗体可能偶尔看起来不太好。例如，按钮的一小部分将在用户窗体的其他位置保持可见或有延缓。此时，可以将Me.Repaint添加到Resizing事件中。

注：本文学习整理自worksheetsvba.com，供有兴趣的朋友参考。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。

欢迎到知识星球：完美Excel社群，进行技术交流和提问，获取更多电子资料，并通过社群加入专门的微信讨论群，更方便交流。