Vba userform control box code amendment needed.

[kelly mort]

Private Sub UserForm_Initialize()
    
    Call CreateMenu
    Call StoreInitialControlMetrics
    
    'PostMessage hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0
End Sub


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 If
        End With
    Next
    Dim arr() As String
    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
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
'''''''''''''''''''''''''''''''''''''''''''''''''''

Hello wonderful people,

I have this code here which was written for me by @Jaafar Tribak some time back.

At the time, I was on office 2016 so he wrote the code based on that version.

The code is a great one which works great and adjust all controls as well.

The only issue I am facing right now is that when I install office 2016 for the first time, it works good. But after I connect to Internet, the code fails to create the control boxes.

I have also tried it with other office versions and it fails to work.

If there is a way to handle this could someone please help me out?

 

[Dan_W]

It's failing perhaps because you're missing parts of the code.

 

[kelly mort]

Oh okay
Then I will check that and see