Control Resize Code

[Mark Gambo]

Ok, here is version 2.0.0:

In a Class Module (Leave the name as Class1):

Option Explicit
Public a As Long
Public sngFrmTop As Single
Public sngFrmLeft As Single
Public sngFrmHeight As Single
Public sngFrmWidth As Single
 
Public Sub ControlResize(FormName As Form)
On Error GoTo ControlResize_Error
 
With FormName
    If .WindowState = vbMinimized Then Exit Sub
    
        sngFrmTop = .Top
        sngFrmLeft = .Left
        sngFrmHeight = .Height
        sngFrmWidth = .Width
        
        For a = 0 To .Controls.Count - 1
            With .Controls(a)
                .FontSize = Int(sngFrmHeight * ControlMetrix(a).sngCntFontSize)
                .Top = sngFrmHeight * ControlMetrix(a).sngCntTop
                .Left = sngFrmWidth * ControlMetrix(a).sngCntLeft
                .Height = sngFrmHeight * ControlMetrix(a).sngCntHeight
                .Width = sngFrmWidth * ControlMetrix(a).sngCntWidth
            End With
        Next a
       
End With
 
On Error GoTo 0
Exit Sub
 
ControlResize_Error:
If Err.Number = 383 Or Err.Number = 438 Or _
        Err.Number = 380 Then
     'Catch Error for controls with read only properties
    Resume Next
Else
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
          ") in procedure ControlResize of Class Module Class1"
End If
 
End Sub
 
Public Sub GetFormMetrix(FormName As Form)
On Error GoTo GetFormMetrix_Error
 
With FormName
    sngFrmTop = .Top
    sngFrmLeft = .Left
    sngFrmHeight = .Height
    sngFrmWidth = .Width
    
    ReDim ControlMetrix(.Controls.Count - 1)
        
    For a = 0 To .Controls.Count - 1
    
        With .Controls(a)
            ControlMetrix(a).sngCntTop = (.Top / sngFrmHeight)
            ControlMetrix(a).sngCntLeft = (.Left / sngFrmWidth)
            ControlMetrix(a).sngCntHeight = (.Height / sngFrmHeight)
            ControlMetrix(a).sngCntWidth = (.Width / sngFrmWidth)
            ControlMetrix(a).sngCntFontSize = (.FontSize / sngFrmHeight)
        End With
    
    Next a
End With
 
On Error GoTo 0
Exit Sub
 
GetFormMetrix_Error:
If Err.Number = 13 Or Err.Number = 383 Or Err.Number = 438 Or _
        Err.Number = 380 Then 
     'Catch Error for controls with read only properties
    Resume Next
Else
    MsgBox "Error " & Err.Number & " (" & Err.Description & _
          ") in procedure GetFormMetrix of Class Module Class1"
End If
End Sub

In a BAS Module:

Option Explicit
 
Public Type ControlMetrix
    sngCntTop As Single
    sngCntLeft As Single
    sngCntHeight As Single
    sngCntWidth As Single
    sngCntFontSize As Single
End Type
 
Public ControlMetrix() As ControlMetrix

and in the Form copy the following code and
place some controls in various positions on the form:

Option Explicit
 
Private FormResize As Class1
 
Private Sub Form_Load()
    Set FormResize = New Class1
    Call FormResize.GetFormMetrix(Me)
End Sub
 
Private Sub Form_Resize()
    Call FormResize.ControlResize(Me)
End Sub