简体   繁体   中英

Resize Userform and its Controls with VBA

I am trying to resize a userform and its controls with VBA in order to accommodate different size monitors. Following is the code I am using which is based on Ron DeBruin's code ( http://www.rondebruin.nl/mac/mac022.htm ).

In essence, the code is designed to scale the userform's size and location together with all of its controls.

The problem is I'm getting an error (shown below) on execution

"Run-time error '-2147467259(80004005)': Method 'Properties' of object '_VBComponent' failed"

I tried replacing .Properties("Top") with .Top and I got the Object doesn't support this property or method error.

Mr. DeBruin's code makes since; but I am at a loss as to why it is not working. Any help would certainly be appreciated.

Sub ChangeUserFormAndControlsSize()
    Dim AppUserform As Object
    Dim FormControl As Object
    Dim NameUserform As String
    Dim SizeCoefficient As Single

    SizeCoefficient = wsControls.Range("SizeCoefficient")

    NameUserform = "form_APScheduler"

    Set AppUserform = ThisWorkbook.VBProject.VBComponents(NameUserform)
    With AppUserform
        .Properties("Top") = .Properties("Top") * SizeCoefficient   '*** ERROR OCCURS HERE
        .Properties("Left") = .Properties("Left") * SizeCoefficient
        .Properties("Height") = .Properties("Height") * SizeCoefficient
        .Properties("Width") = .Properties("Width") * SizeCoefficient
    End With

    For Each FormControl In AppUserform.Designer.Controls
        With FormControl
            .Top = .Top * SizeCoefficient
            .Left = .Left * SizeCoefficient
            .Width = .Width * SizeCoefficient
            .Height = .Height * SizeCoefficient

            On Error Resume Next
            .Font.Size = .Font.Size * SizeCoefficient
            On Error GoTo 0
        End With
    Next FormControl

End Sub

Based on your last comment, here is some example code showing how to change the properties at run time, without accessing the VBIDE.VBProject object. Of course, these changes will not persist.

Option Explicit
Sub testForm()
Dim UF As form_APScheduler
Dim FormControl As MSForms.Control
Dim SizeCoefficient As Double

    SizeCoefficient = inputNumber("Scale Factor: ", "Form", 1)
    Set UF = New form_APScheduler
    With UF
        .Top = .Top * SizeCoefficient
        .Left = .Left * SizeCoefficient
        .Width = .Width * SizeCoefficient
        .Height = .Height * SizeCoefficient
    End With
    For Each FormControl In UF.Controls
        With FormControl
            .Top = .Top * SizeCoefficient
            .Left = .Left * SizeCoefficient
            .Width = .Width * SizeCoefficient
            .Height = .Height * SizeCoefficient

            On Error Resume Next
            .Font.Size = .Font.Size * SizeCoefficient
            On Error GoTo 0
        End With
    Next FormControl
    UF.Show
    Unload UF
End Sub
Function inputNumber(prompt As String, title As String, defValue As Variant) As Variant
    inputNumber = Application.InputBox(prompt, title, defValue, , , , , 1)
End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM