Tạo Userform resize with VBA or Windows API

Nhưng nó sẽ chỉ hoạt động trên Windows. Nếu mã của bạn dự kiến ​​sẽ hoạt động trên Windows và Mac, thì sử dụng giải pháp VBA là lựa chọn tốt hơn.

Mã API Windows sử dụng các hàm đặc biệt, không phải là một phần của Excel hoặc VBA, nhưng là một phần của ứng dụng Windows chính. Chủ đề về mã API Windows là quá lớn để thảo luận ở đây,

Nhưng bằng cách làm theo các hướng dẫn bên dưới, bạn vẫn có thể làm cho mã hoạt động, ngay cả khi bạn không hiểu đầy đủ về lý do tại sao nó hoạt động.

Các bạn có thể tham khảo các bài viết như bên dưới.

Phần mềm xuất nhập tồn bằng Excel miễn phí 2021

Chuyển đổi số thành chữ viết bằng Code VBA

Tìm kiếm dữ liệu trong listbox từ textbox

I.CÔNG DỤNG

• Thay đổi kích thước, bất kì cho 1 userform nào co giãn mượt mà.
• Full màn hình cho Windown

II. Hướng dẫn cách tạo Userform resize with VBA or Windows API.

Bước 1 : tạo 1 Model Coppy toàn bộ Code này vào Model vừa tạo.

Option Explicit

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongLong, ByVal nIndex As Long) As LongLong
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongLong, ByVal nIndex As Long, ByVal dwNewLong As LongLong) As LongLong
    #Else
        Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
        Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    #End If
    Private Declare PtrSafe Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
    Private Declare Function IUnknown_GetWindow Lib "shlwapi" Alias "#172" (ByVal pIUnk As IUnknown, ByVal hwnd As Long) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32.dll" (ByVal hwnd As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

Private dInitWidth As Single, dInitHeight As Single, Ufrm As Object

Public Sub MakeFormResizeable(ByVal UF As Object)
    Set Ufrm = UF
    Call CreateMenu
    Call StoreInitialControlMetrics

    'OPTIONAL: maximize the form full-screen upon first showing.
    '========
    #If Win64 Then
        Dim hwnd As LongLong
    #Else
        Dim hwnd As Long
    #End If
    
    Const WM_SYSCOMMAND = &H112
    Const SC_MAXIMIZE = &HF030&

    Call IUnknown_GetWindow(UF, VarPtr(hwnd))
    Call PostMessage(hwnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0)
    
End Sub
Public Sub AdjustSizeOfControls(Optional ByVal Dummey As Boolean)

    Dim oCtrl As Control
 
    For Each oCtrl In Ufrm.Controls
        With oCtrl
            If .Tag <> "" Then
                .Width = Split(.Tag, "*")(0) * ((Ufrm.InsideWidth) / dInitWidth)
                .Left = Split(.Tag, "*")(1) * (Ufrm.InsideWidth) / dInitWidth
                .Height = Split(.Tag, "*")(2) * (Ufrm.InsideHeight) / dInitHeight
                .Top = Split(.Tag, "*")(3) * (Ufrm.InsideHeight) / dInitHeight
                If HasFont(oCtrl) Then
                    .Font.Size = Split(.Tag, "*")(4) * (Ufrm.InsideWidth) / dInitWidth
                End If
            End If
        End With
    Next  
    Ufrm.Repaint  
End Sub
Private Sub StoreInitialControlMetrics()
    Dim oCtrl As Control
    Dim dFontSize As Currency

    dInitWidth = Ufrm.InsideWidth
    dInitHeight = Ufrm.InsideHeight
    For Each oCtrl In Ufrm.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()
    #If Win64 Then
        Dim hwnd As LongLong
        Dim lStyle As LongLong
    #Else
        Dim hwnd As Long
        Dim lStyle As Long
    #End If 
    Const GWL_STYLE = -16
    Const WS_SYSMENU = &H80000
    Const WS_MINIMIZEBOX = &H20000
    Const WS_MAXIMIZEBOX = &H10000
    Const WS_THICKFRAME = &H40000  
    Call IUnknown_GetWindow(Ufrm, VarPtr(hwnd))
    lStyle = GetWindowLong(hwnd, GWL_STYLE)  
    lStyle = lStyle Or WS_SYSMENU Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX Or WS_THICKFRAME
    Call SetWindowLong(hwnd, GWL_STYLE, lStyle)
    Call 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

Bước 2: Tạo 1 USERFORM, copy Code sau vào USERFROM vừa tạo.

Option Explicit
Private Sub UserForm_Initialize()
    Call MakeFormResizeable(Me)
End Sub
Private Sub UserForm_Resize()
    Call AdjustSizeOfControls
End Sub

III.TẢI XUỐNG

1. Tải file demo tại đây

Như vậy, chúng tôi đã hướng dẫn đến các bạn cách Tạo Userform resize with VBA or Windows API. Hy vọng, nó sẽ giúp các bạn phần nào trong quá trình học tập, cũng như nâng cao hiệu quả làm việc.

Chúc bạn thành công.