Maken van resizable VBA formulier

Tijdens het ontwerpen een formulier wordt de afmeting hiervan ingesteld. Ook kan dan eventueel ingesteld worden dat het formulier gecentreerd moet worden en dat automatisch schuifbalken moeten worden toegevoegd bij kleinere schermen (zie hiervoor VBA formulier centreren en schuifbalken instellen). Tijdens runtime kan de gebruiker echter de afmetingen van het formulier niet veranderen. In sommige Windows formulieren kan dat echter wel. Een voorbeeld hiervan is het Excel formulier voor het aanpassen van het Lint (Bestand -> Opties -> Lint aanpassen). Met de muis kan dat formulier vergroot of verkleind worden door de rechteronderhoek of de formulierrand (rechts of onder) te verslepen.

Het zou mooi zijn om een dergelijke optie ook te kunnen toevoegen aan VBA formulieren. In dit artikel komt een methode aan de orde, die volledig op VBA is gebaseerd, waarbij deze optie gemakkelijk kan worden toegevoegd aan formulieren.

Bij deze methode wordt gebruik gemaakt van een klassenmodule. In deze klassenmodule, die in de UserForm_Initialize gebeurtenis aan het formulier wordt gekoppeld, worden automatisch de benodigde besturingselementen aan het formulier toegevoegd om het wijzigen van de afmeting te kunnen regelen. Hierbij wordt gebruik gemaakt van Frames, zodat zeker gesteld wordt dat deze resize controls altijd OnTop van eventueel andere aanwezige besturingselementen, die zich vlak bij de formulierrand bevinden, wordt geplaatst. Met een Label kan dat bijvoorbeeld niet.

Het wijzigen van de afmeting van het formulier wordt verder helemaal door de klassenmodule geregeld. Voeg daarom een klassenmodule toe met de naam clUserFormResizeren zet daarin de volgend code:

'--------------------------------------------------------------------------------------------------------------------------
' Auteur    : Manfred van den Noort
' Copyright : © 2020 worksheetsvba.com, alle rechten voorbehouden
' Datum     : 2020-12-11
' Versie    : 1.0
' Doel      : Maken van Resizable UserForm
'--------------------------------------------------------------------------------------------------------------------------

Private WithEvents frmResizableForm As MSForms.UserForm
Private oResizableForm As Object
Private WithEvents frResizerCorner As MSForms.Frame
Private WithEvents frResizerRight As MSForms.Frame
Private WithEvents frResizerBottom As MSForms.Frame
Private sngMinHeight As Single
Private sngMinWidth  As Single
Private sngMouseX As Single
Private sngMouseY As Single

Event Resizing(ByVal X As Single, ByVal Y As Single)

Friend Property Set ResizableForm(ByRef oFrm As Object)
    Set frmResizableForm = oFrm
    Set oResizableForm = oFrm
    'instellen van standaard waarden voor MinHeight en MinWidth als deze nog niet ingesteld zijn of als deze groter zijn dan de initiële formulier afmetingen
    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
    AddResizeControls
End Property

Friend 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 If
End Property

Friend 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 If
End Property

Private Sub AddResizeControls()
    'frames worden gebruikt om zeker te stellen dat de resize controls altijd bovenop andere formulier controls komen te staan
    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 With
End Sub

Private 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 If
End Sub

Private 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 If
End Sub

Private 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 If
End Sub

Private 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 If
End Sub

Private 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 With
End Sub

Deze klassenmodule moet samenwerken met het formulier die schaalbaar moet worden. Bij het opstarten van het formulier moet daarom een instantie van deze klasse worden aangemaakt. Er moet daarvoor een variabele toegevoegd worden aan de bovenzijde van het formulier en er moeten 2 regels code toegevoegd worden aan de UserForm_Initialize gebeurtenis:

Private WithEvents oFormResize As clUserFormResizer

Private Sub UserForm_Initialize()
    Set oFormResize = New clUserFormResizer
    Set oFormResize.ResizableForm = Me
End Sub

Maar alleen het wijzigen van de afmeting van het formulier is natuurlijk niet voldoende. Ook de op het formulier aanwezige andere besturingselementen moeten dan van afmeting veranderen en/of meebewegen. Het is echter vrijwel onmogelijk om hiervoor een algemeen algoritme te maken, waarmee dit ook de klassenmodule geregeld kan worden. Om hiervan een voorbeeld te geven: afhankelijk van het doel van het formulier, de positie van de buttons en het doel van de buttons, moeten buttons soms op dezelfde plaats blijven staan, moeten ze soms meebewegen, maar kan het ook gewenst zijn dat ze naast het meebewegen ook van afmeting veranderen. In het laatste geval kan het ook gewenst zijn dat daarnaast ook de lettergrootte veranderd moet worden. Daarom is aan de klassenmodule een Resizing Event toegevoegd, zodat per formulier goed kan worden ingesteld hoe de andere besturingselementen moeten reageren op een verandering van de afmeting van het formulier.

Voor een heel eenvoudig formulier met alleen en listbox en een close button is deze code erg simpel en kan er bijvoorbeeld als volgt uit zien:

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 With
End Sub

Afhankelijk van de computer en grafische kaart kan het heel soms voorkomen dat tijdens het resizen het formulier er niet helemaal strak uitziet. Er blijft dan bijvoorbeeld ergens een heel klein gedeelte van een button op een andere plek op het formulier zichtbaar. Mocht dit gebeuren dan kan eventueel Me.Repaint toegevoegd worden aan de Resizing gebeurtenis.

Eventueel kan bij het configureren van de clUserFormResizeren ook nog de minimum hoogte en breedte ingesteld worden. Standaard worden hiervoor de initiële afmetingen van het formulier gebruikt. Kleinere afmetingen hiervoor kunnen ingesteld worden, maar check dan goed of dit geen foutmeldingen geeft bij het kleiner maken van het formulier. Te kleine minimum waarden kunnen namelijk leiden tot foutmeldingen, omdat dan ongeldige waarden voor de afmetingen van besturingselementen kunnen ontstaan.

Er is een voorbeeldbestand voor download beschikbaar waarin bovenstaande code is opgenomen en waaraan ook 2 voorbeeldformulieren zijn toegevoegd. Het ene formulier is heel eenvoudig van opzet en het andere formulier bevat wat meer besturingselementen. Op die manier is goed te zien hoe geconfigureerd kan worden, hoe de besturingselementen van het formulier moeten reageren op een wijziging van de afmeting van het formulier.

Maken van resizable formulier 1.0

Download

Vragen / suggesties

Hopelijk heeft dit artikel geholpen bij het maken van resizable VBA formulieren. Als er verdere vragen over dit onderwerp zijn of suggesties voor verbetering, plaats dan een reactie hieronder.