Code Adjustment Needed : VBA Code To Override Resizing UserForm Controls Code

[kelly mort]

The code below here was written for me long ago by @Jaafar Tribak , when I needed help to make my userform behave like a window, while resizing all the controls on the form to match the updated size.

It has worked great for me until I decided to do something else and I realized the resizing code is interfering with what I wanted to do. I am running a progress bar on the userform and what happens is that the progress bar fail to work when I call the resizing macros:

Private Sub UserForm_Initialize()
    Call CreateMenu
    Call StoreInitialControlMetrics

    PostMessage hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0
End Sub

But when I turn off the resize macros. the progress bar works fine.

Is there a way I can tweak the resize code to allow me have the window behaviour on my userform - adjusting the controls to match, while having my progress bar work as well?

Thanks in advance

Private Sub UserForm_Resize()
    Dim oCtrl As Control
    For Each oCtrl In Me.Controls
        With oCtrl
            If .Tag <> "" Then
                .Width = Split(.Tag, "*")(0) * ((Me.InsideWidth) / dInitWidth)
                .Left = Split(.Tag, "*")(1) * (Me.InsideWidth) / dInitWidth
                .Height = Split(.Tag, "*")(2) * (Me.InsideHeight) / dInitHeight
                .Top = Split(.Tag, "*")(3) * (Me.InsideHeight) / dInitHeight
                If HasFont(oCtrl) Then .Font.Size = Split(.Tag, "*")(4) * (Me.InsideWidth) / dInitWidth
            End If
        End With
    Next
    Dim arr() As String, i&
    If Len(sIntialColumnWidth) > 0 Then
        arr = Split(Replace(sIntialColumnWidth, "pt", ""), ";")
        For i = LBound(arr) To UBound(arr)
            arr(i) = arr(i) * PxToPt(CLng((Me.InsideWidth) / dInitWidth), False)
        Next i
    End If
    Me.Repaint
End Sub

Private Sub StoreInitialControlMetrics()
    Dim oCtrl As Control, dFontSize As Currency
    dInitWidth = Me.InsideWidth
    dInitHeight = Me.InsideHeight
    For Each oCtrl In Me.Controls
        With oCtrl
            On Error Resume Next
                dFontSize = IIf(HasFont(oCtrl), .Font.Size, 0)
            On Error GoTo 0
            .Tag = .Width & "*" & .Left & "*" & .Height & "*" & .Top & "*" & dFontSize
        End With
    Next
End Sub
 
Private Sub CreateMenu()
    Call WindowFromAccessibleObject(Me, hwnd)
    lStyle = GetWindowLong(hwnd, GWL_STYLE)
    lStyle = lStyle Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME
    SetWindowLong hwnd, GWL_STYLE, lStyle
    DrawMenuBar hwnd
End Sub

Private Function HasFont(ByVal oCtrl As Control) As Boolean
    Dim oFont As Object
    On Error Resume Next
    Set oFont = CallByName(oCtrl, "Font", VbGet)
    HasFont = Not oFont Is Nothing
    On Error GoTo 0
End Function

Private Function ScreenDPI(bVert As Boolean) As Long
    Static lDPI(1), lDC
    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If
    ScreenDPI = lDPI(Abs(bVert))
End Function

Private Function PxToPt(Points As Single, bVert As Boolean) As Long
    PxToPt = Points / (ScreenDPI(bVert) / POINTSPERINCH)
End Function