Zoom Userform & Controls

Liên hệ QC

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,649
Được thích
10,138
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Theo ý tưởng của minhthien321 tại chủ đề Tặng các bạn thủ tục Form Zoom tôi làm với một phương pháp khác, tạo ra một form cho phép cõ giãn kích cỡ của form, các controls tự động co giãn theo tỷ lệ của form.

Cách làm rất đơn giản. Bạn hãy làm theo hướng dẫn sau:

1. Mở Userform, View Code
2. Dán đoạn code sau vào
Mã:
Option Explicit
[COLOR="#008000"][B]'Khai báo API[/B][/COLOR]
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME

[COLOR="#008000"][B]'Khai báo biến cho form[/B][/COLOR]
Dim hWnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
'--------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
[COLOR="#008000"]   'Nhận độ rộng và độ cao ban đầu của form[/COLOR]
    OldWidth = Width
    OldHeight = Height
[COLOR="#008000"]   'Nhận handle/hWnd của form[/COLOR]
    If Val(Application.Version) < 9 Then
        hWnd = FindWindow("ThunderXFrame", Caption) [COLOR="#008000"] 'XL97[/COLOR]
    Else
        hWnd = FindWindow("ThunderDFrame", Caption) [COLOR="#008000"] 'XL2000[/COLOR]
    End If
[COLOR="#008000"]   'hWnd được dùng để thiết lập thuộc tính co giãn form, thêm nút Min, Max[/COLOR]
    PrevStyle = GetWindowLong(hWnd, GWL_STYLE)
    SetWindowLong hWnd, GWL_STYLE, PrevStyle _
                                Or WS_SIZEBOX _
                                Or WS_MINIMIZEBOX _
                                Or WS_MAXIMIZEBOX
End Sub
'--------------------------------------------------------------------------------------------
[COLOR="#008000"]   'Khi form co giãn thì tính lại Zoom theo chiều rộng của form[/COLOR]
Private Sub UserForm_Resize()
    Zoom = Round(Width / OldWidth * 100, 0)
End Sub

Sau khi thiết lập đúng như trên, bạn sẽ làm được như hình dưới đây:


zoomform.gif

Code hoàn chỉnh tôi gửi trong file đính kèm.
 

File đính kèm

  • ZoomFormAndControls.xls
    61.5 KB · Đọc: 438
Chỉnh sửa lần cuối bởi điều hành viên:
Sau khi minhthien321 góp ý về việc không dùng hàm ROUND thì màn hình mịn, mặc dù thấy vô lý nhưng mình cũng đã kiểm tra lại việc không dùng hàm ROUND, thì lúc chạy cũng không khác một chút nào với trước, màn hình vẫn không đạt mịn.

Còn viết code để Height tự thay đổi theo Width thì code như dưới đây.

Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom As Long, CurStyle&
    If Not AllowResize Then Exit Sub
    CurStyle = GetWindowLong(hWnd, GWL_STYLE)
    tmpZoom = Round(Width / OldWidth * 100, 0)
    If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
    If tmpZoom > ZoomMax Then tmpZoom = ZoomMax
    If tmpZoom = ZoomMin Or tmpZoom = ZoomMax Then
        'Neu khong phai la phong to man hinh thi co lai kich co
        If Not (CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Then
            AllowResize = False 'Ngan khong chay UserForm_Resize khi dang thay doi size
            Width = tmpZoom * OldWidth / 100
            Height = Width * OldHeight / OldWidth
            AllowResize = True 'Cho phep resize
        Else
            
        End If
    End If
[COLOR=#0000FF]    If Not ((CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Or _
            (CurStyle And WS_MINIMIZE) = WS_MINIMIZE) Then
        Height = Width * OldHeight / OldWidth
    End If[/COLOR]
    Zoom = tmpZoom
End Sub


Phải công nhận là code mới Update này đã không còn giật giật nữa! Em thích cái này rồi, còn ban đầu thì nó chớp chớp khó chịu lắm!

Một lần nữa Cám ơn Anh Tuân!
 
Upvote 0
Còn một vấn đề nữa em nhờ Anh Tuân chỉ dùm em là thủ tục nào khi Form được load lên thì nó được kích hoạt nút Max ngay khi show Form? Bởi vì tâm lý chung người dùng thường thích nó Max, khỏi phải bấm nút Max, trừ khi họ muốn normal view. Mỗi lần show form, mỗi lần bấm nút Max thì cũng khá mất thời gian, nhất là sử dụng trên nhiều form. Anh vui lòng giúp em vấn đề này nhé!

Cám ơn Anh rất nhiều!
 
Upvote 0
Còn một vấn đề nữa em nhờ Anh Tuân chỉ dùm em là thủ tục nào khi Form được load lên thì nó được kích hoạt nút Max ngay khi show Form? Bởi vì tâm lý chung người dùng thường thích nó Max, khỏi phải bấm nút Max, trừ khi họ muốn normal view. Mỗi lần show form, mỗi lần bấm nút Max thì cũng khá mất thời gian, nhất là sử dụng trên nhiều form. Anh vui lòng giúp em vấn đề này nhé!

Cám ơn Anh rất nhiều!
Cái này dễ mà
PHP:
Width = Application.Width
Height = Application.Height
Cẩn thận hơn thì ta cho Application.WindowState = xlMaximized trước đó
 
Upvote 0
Cái này dễ mà
PHP:
Width = Application.Width
Height = Application.Height
Cẩn thận hơn thì ta cho Application.WindowState = xlMaximized trước đó

Không thể dùng cái này được đâu Thầy ơi, hồi xưa em ngán cái này lắm, bởi khi Window đang ở trạng thái Min, normal, hoặc visible thì cái form nó kinh dị lắm! Và đó đang là dạng Form Normal, khi Zoom max cũng vậy, nomal cũng thế! Vã lại, em thích Form chủ động thực hiện chứ không thích nó "ăn theo" của ai hết đó.
 
Lần chỉnh sửa cuối:
Upvote 0
Không thể dùng cái này được đâu Thầy ơi, hồi xưa em ngán cái này lắm, bởi khi Window đang ở trạng thái Min, normal, hoặc visible thì cái form nó kinh dị lắm! Và đó đang là dạng Form Normal, khi Zoom max cũng vậy, nomal cũng thế! Vã lại, em thích Form chủ động thực hiện chứ không thích nó "ăn theo" của ai hết đó.
Xem file đính kèm!
Sao mà KHÔNG THỂ chứ
 

File đính kèm

  • ZoomFormAndControls.xls
    70 KB · Đọc: 127
Upvote 0
Xem file đính kèm!
Sao mà KHÔNG THỂ chứ

Em đã nói rồi mà chắc Thầy vẫn chưa hiểu ý em. Lúc đầu ta thiết kế ở dạng Normal, tức là khi Max thì nó full màn hình, còn Nomal thì nó trở về với dạng thiết kế, trừ khi Form đang load mà ta resize thủ công kéo giản form thì nó normal theo kích thước đó trong lúc nó vẫn đang load, nếu unload thì nó cũng quay lại kích cỡ ban đầu chứ không giữ lại như các cửa sổ khác. Còn với Form ăn theo cửa sổ Application, khi mở ra, đồng ý là nó gần như full và khi ta max nó có giản ra vài milimet, khi normal thì cũng giảm vài milimet, điều này có vẻ như ta đã hủy chức năng normal của form rồi.

=> Ta cần để form tự kích hoạt nút Max, khi form load, nó đang ở trạng thái Max chứ không phải ăn theo cửa sổ khác. Khi mở một lúc 2 file excel, 1 file đang ở trang thái này, file ở trạng thái khác, nó sẽ "ngu" ra đấy!
 
Upvote 0
Còn một vấn đề nữa em nhờ Anh Tuân chỉ dùm em là thủ tục nào khi Form được load lên thì nó được kích hoạt nút Max ngay khi show Form? Bởi vì tâm lý chung người dùng thường thích nó Max, khỏi phải bấm nút Max, trừ khi họ muốn normal view. Mỗi lần show form, mỗi lần bấm nút Max thì cũng khá mất thời gian, nhất là sử dụng trên nhiều form. Anh vui lòng giúp em vấn đề này nhé!

Cám ơn Anh rất nhiều!

Để làm được vậy ta cần làm 2 việc:

1. Thiết lập thuộc tính của Userform ShowModel = False
2. Khai báo thêm trong form đoạn code dưới đây

Mã:
[COLOR="#008000"]'Trên đầu form[/COLOR]
Private Const SW_MAXIMIZE = 3
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
[COLOR="#008000"]'Viết sự kiện [B]UserForm_Activate[/B][/COLOR]

Private Sub UserForm_Activate()
    ShowWindow hWnd, [COLOR="#FF0000"]SW_MAXIMIZE[/COLOR]
End Sub

Lập trình API hãy dùng hằng số nhé, đừng bao giờ viết là ShowWindow hWnd, 3 mặc dù chạy được nhưng nó không phải phương pháp chuẩn, không tường minh.
 
Lần chỉnh sửa cuối:
Upvote 0
Em đã nói rồi mà chắc Thầy vẫn chưa hiểu ý em. Lúc đầu ta thiết kế ở dạng Normal, tức là khi Max thì nó full màn hình, còn Nomal thì nó trở về với dạng thiết kế, trừ khi Form đang load mà ta resize thủ công kéo giản form thì nó normal theo kích thước đó trong lúc nó vẫn đang load, nếu unload thì nó cũng quay lại kích cỡ ban đầu chứ không giữ lại như các cửa sổ khác. Còn với Form ăn theo cửa sổ Application, khi mở ra, đồng ý là nó gần như full và khi ta max nó có giản ra vài milimet, khi normal thì cũng giảm vài milimet, điều này có vẻ như ta đã hủy chức năng normal của form rồi.

=> Ta cần để form tự kích hoạt nút Max, khi form load, nó đang ở trạng thái Max chứ không phải ăn theo cửa sổ khác. Khi mở một lúc 2 file excel, 1 file đang ở trang thái này, file ở trạng thái khác, nó sẽ "ngu" ra đấy!
Thích thì cũng chơi được
PHP:
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
  ByVal nCmdShow As Long) As Long
PHP:
Private Sub UserForm_Activate()
 ShowWindow hwnd, 3
End Sub
--------------------------
1. Thiết lập thuộc tính của Userform ShowModel = False
Cái này hình như không cần
 
Upvote 0
Code này rất haynhưng Windows 8.1 64 bit báo lỗi tại dòng này không chịu chạy mong bác ndu chỉgiáo vớiPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow
As Long) As Long
 
Upvote 0
Code này rất haynhưng Windows 8.1 64 bit báo lỗi tại dòng này không chịu chạy mong bác ndu chỉgiáo vớiPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow
As Long) As Long

Ủa sao liên quan đến ndu là sao bạn ?

Bạn thay thế đoạn code dưới đây vào chỗ báo lỗi nhé. Code này sẽ chạy cho mọi môi trường 32, 64 bit.

[GPECODE=vb]
#If VBA7 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, _
ByVal nCmdShow As LongPtr) As LongPtr
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
#End If
[/GPECODE]
 
Upvote 0
Theo ý tưởng của minhthien321 tại chủ đề Tặng các bạn thủ tục Form Zoom tôi làm với một phương pháp khác, tạo ra một form cho phép cõ giãn kích cỡ của form, các controls tự động co giãn theo tỷ lệ của form.

Cách làm rất đơn giản. Bạn hãy làm theo hướng dẫn sau:

1. Mở Userform, View Code
2. Dán đoạn code sau vào
Mã:
Option Explicit
[COLOR=#008000][B]'Khai báo API[/B][/COLOR]
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Const GWL_STYLE = (-16)
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const WS_THICKFRAME = &H40000
Private Const WS_SIZEBOX = WS_THICKFRAME

[COLOR=#008000][B]'Khai báo biến cho form[/B][/COLOR]
Dim hWnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
'--------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
[COLOR=#008000]   'Nhận độ rộng và độ cao ban đầu của form[/COLOR]
    OldWidth = Width
    OldHeight = Height
[COLOR=#008000]   'Nhận handle/hWnd của form[/COLOR]
    If Val(Application.Version) < 9 Then
        hWnd = FindWindow("ThunderXFrame", Caption) [COLOR=#008000] 'XL97[/COLOR]
    Else
        hWnd = FindWindow("ThunderDFrame", Caption) [COLOR=#008000] 'XL2000[/COLOR]
    End If
[COLOR=#008000]   'hWnd được dùng để thiết lập thuộc tính co giãn form, thêm nút Min, Max[/COLOR]
    PrevStyle = GetWindowLong(hWnd, GWL_STYLE)
    SetWindowLong hWnd, GWL_STYLE, PrevStyle _
                                Or WS_SIZEBOX _
                                Or WS_MINIMIZEBOX _
                                Or WS_MAXIMIZEBOX
End Sub
'--------------------------------------------------------------------------------------------
[COLOR=#008000]   'Khi form co giãn thì tính lại Zoom theo chiều rộng của form[/COLOR]
Private Sub UserForm_Resize()
    Zoom = Round(Width / OldWidth * 100, 0)
End Sub

Sau khi thiết lập đúng như trên, bạn sẽ làm được như hình dưới đây:
zoomform.gif

Code hoàn chỉnh tôi gửi trong file đính kèm.
bạn viết giùm code khi click buttton1 nó hiện userform1 full màn hình luôn được không hi
 
Upvote 0
Code này rất haynhưng Windows 8.1 64 bit báo lỗi tại dòng này không chịu chạy mong bác ndu chỉgiáo vớiPrivate Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow
As Long) As Long

Mình mới cập nhật mã nguồn zoom userform và controls chạy trong môi trường 32 hoặc 64-bit tại đây:
http://bluesofts.net/cac-bai-hoc-ha...nho-userform-va-controls-trong-excel-vba.html
 
Upvote 0
Cần giúp đỡ về userform khi thể hiện trên các máy khác nhau

Dear Thầy Tuân

Em đã làm theo code mà Thấy cung cấp và ok trên máy PC em đang sử dụng (21 inches). Nhưng khi chuyển qua máy PC (17 inches) thì khi view full screen thì màn hình 17 inches không tự động co form vô cho đủ (Vì màn hình của em là hình chữ nhật và form em thiết kế cũng dạng hình chữ nhật. Còn màn hình 17 inches là màn hình vuông nên khi view không đủ chứa form). Vậy có cách nào cho form có thể linh hoạt view khi ở bất cứ màn hình nào nó cũng có thể co giãn tỷ lệ theo màn hình không Thầy?

Em có thử tìm code nhưng chưa ra. Mong Thầy giúp đỡ em. Em cám ơn thầy nhiều.

Mình mới cập nhật mã nguồn zoom userform và controls chạy trong môi trường 32 hoặc 64-bit tại đây:
http://bluesofts.net/cac-bai-hoc-ha...nho-userform-va-controls-trong-excel-vba.html
 
Upvote 0
Mình mới cập nhật mã nguồn zoom userform và controls chạy trong môi trường 32 hoặc 64-bit tại đây:
http://bluesofts.net/cac-bai-hoc-ha...nho-userform-va-controls-trong-excel-vba.html

Đối với trường hợp kéo từ lưới dưới cùng Form xuống dưới nữa thì Form sẽ dư ra 1 khoảng trống.
Có cách nào khắc phục được không anh
[video=youtube;CPv589U_NvY]https://www.youtube.com/watch?v=CPv589U_NvY&amp;feature=youtu.be[/video]
 
Upvote 0
Đối với trường hợp kéo từ lưới dưới cùng Form xuống dưới nữa thì Form sẽ dư ra 1 khoảng trống.
Có cách nào khắc phục được không anh
[video=youtube;CPv589U_NvY]https://www.youtube.com/watch?v=CPv589U_NvY&feature=youtu.be[/video]

Để tự chỉnh lại tỷ lệ form khi chiều cao form tỷ lệ lớn hơn chiều rộng thì cách chỉnh như sau. Tuy nhiên cách này màn hình bị giựt nhiều.
Code bổ sung có màu xanh.
Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom&, CurStyle&
    Dim tmpWidth As Double, tmpZoomH As Double
    If Not AllowResize Then Exit Sub
    CurStyle = GetWindowLong(hwnd, GWL_STYLE)
    tmpZoom = Round(Width / OldWidth * 100, 0)
[COLOR="#0000FF"]    tmpZoomH = Round(Height / OldHeight * 100, 0)
    If tmpZoom < tmpZoomH Then
        tmpZoom = tmpZoomH
        Width = tmpZoom * OldWidth / 100
    End If
[/COLOR]    If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
    If tmpZoom > ZoomMax Then tmpZoom = ZoomMax
    
    AllowResize = False 'Ngan khong chay UserForm_Resize khi dang thay doi size
    
    If tmpZoom = ZoomMin Or tmpZoom = ZoomMax Then
        'Neu khong phai la phong to man hinh thi co lai kich co
        If Not (CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Then
            Width = tmpZoom * OldWidth / 100
            Height = Width * OldHeight / OldWidth
        End If
    End If
    If (CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Then
        tmpWidth = OldWidth * Height / OldHeight
        tmpZoom = Round(tmpWidth / OldWidth * 100, 0) 'limitZoom
    End If
    'Change height by width
    'If Not ((CurStyle And WS_MAXIMIZE) = WS_MAXIMIZE Or _
    '        (CurStyle And WS_MINIMIZE) = WS_MINIMIZE) Then
    '    Height = Width * OldHeight / OldWidth
    'End If
    AllowResize = True 'Cho phep resize
    Zoom = tmpZoom
End Sub
 
Upvote 0
Dear Thầy Tuân

Em đã làm theo code mà Thấy cung cấp và ok trên máy PC em đang sử dụng (21 inches). Nhưng khi chuyển qua máy PC (17 inches) thì khi view full screen thì màn hình 17 inches không tự động co form vô cho đủ (Vì màn hình của em là hình chữ nhật và form em thiết kế cũng dạng hình chữ nhật. Còn màn hình 17 inches là màn hình vuông nên khi view không đủ chứa form). Vậy có cách nào cho form có thể linh hoạt view khi ở bất cứ màn hình nào nó cũng có thể co giãn tỷ lệ theo màn hình không Thầy?

Em có thử tìm code nhưng chưa ra. Mong Thầy giúp đỡ em. Em cám ơn thầy nhiều.

Banj chụp màn hình lên mình xem nào.
 
Upvote 0
Hình của bạn mờ quá mình không nhìn được. Ngoài code mình viết bạn có thêm gì không, nếu có thì đưa ra đây mình phân tích xem?
 
Upvote 0
Web KT
Back
Top Bottom