Zoom Userform & Controls

Liên hệ QC
Nguyễn Duy Tuân

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,737
Được thích
10,243
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: 439
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nguyễn Duy Tuân đã viết:
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?
Nhấp chuột vào đây để mở rộng...


Dear Thầy

Em đính kèm file Excel bên dưới. Thầy kiểm tra giúp em. Khi code này view trên hình chữ nhật thì form view ok. Nhưng trên hình Vuông thì bị thiếu.
 

File đính kèm

  • 17 inches.jpg
    17 inches.jpg
    16.7 KB · Đọc: 15
  • MAN HINH 21 INCHES.jpg
    MAN HINH 21 INCHES.jpg
    20.8 KB · Đọc: 12
  • M146 (B283243A).xlsm
    81.4 KB · Đọc: 42
Upvote 0
thonggraphicdesign đã viết:
Dear Thầy

Em đính kèm file Excel bên dưới. Thầy kiểm tra giúp em. Khi code này view trên hình chữ nhật thì form view ok. Nhưng trên hình Vuông thì bị thiếu.
Nhấp chuột vào đây để mở rộng...

Màn hình thông thường phân giải theo tỷ lệ theo 2 chuẩn 4:3 và 16:9. Kích cỡ form tối thiếu nên thiết kế nhỏ hơn phạm vi phân giải 1024x800

Tôi góp ý một vấn đề tế nhị là bạn đừng xoá thông tin tác giả gốc để thể hiện tuân thủ bản quyền tác giả dù họ đã share free.
 
Upvote 0
Nguyễn Duy Tuân đã viết:
Màn hình thông thường phân giải theo tỷ lệ theo 2 chuẩn 4:3 và 16:9. Kích cỡ form tối thiếu nên thiết kế nhỏ hơn phạm vi phân giải 1024x800

Tôi góp ý một vấn đề tế nhị là bạn đừng xoá thông tin tác giả gốc để thể hiện tuân thủ bản quyền tác giả dù họ đã share free.
Nhấp chuột vào đây để mở rộng...


Cám ơn thầy. Đây là Form em đang làm và lập trình để sử dụng.
Hiện tại em vẫn chưa hiểu cụ thể trong trường hợp này Form thiết kế như thế nào thì nằm trong phạm vi 1024x800? Thầy có thể nói rõ hơn nữa không ạ. Em cám ơn thầy nhiều.
 
Upvote 0
các anh ơi,

cho em hỏi xíu, cái chữ Zoom ở dưới cùng được hiểu là gì ạ. em thử đặt Dim Zoom as integer thì các ctrol trên form không chay. xin giải thích giúp em ạ.
xin cảm ơn các anh,
1614929586303.png
 
Upvote 0
phuoclocvl đã viết:
các anh ơi,

cho em hỏi xíu, cái chữ Zoom ở dưới cùng được hiểu là gì ạ. em thử đặt Dim Zoom as integer thì các ctrol trên form không chay. xin giải thích giúp em ạ.
xin cảm ơn các anh,
View attachment 254914
Nhấp chuột vào đây để mở rộng...

Zoom là một thành phần thuộc tính của Userform, nó nhận giá trị và sẽ làm thay đổi kích thước các controls trong Userform. Còn khi bạn tạo biến Zoom thì nói chỉ gi nhận giá trị bạn gán mà không làm thay đổi gì tới các controls.
 
Upvote 0
Nguyễn Duy Tuân đã viết:
Zoom là một thành phần thuộc tính của Userform, nó nhận giá trị và sẽ làm thay đổi kích thước các controls trong Userform. Còn khi bạn tạo biến Zoom thì nói chỉ gi nhận giá trị bạn gán mà không làm thay đổi gì tới các controls.
Nhấp chuột vào đây để mở rộng...
Dạ, em hiểu rồi . Cảm ơn Anh!
Bài đã được tự động gộp:

Nguyễn Duy Tuân đã viết:
Zoom là một thành phần thuộc tính của Userform, nó nhận giá trị và sẽ làm thay đổi kích thước các controls trong Userform. Còn khi bạn tạo biến Zoom thì nói chỉ gi nhận giá trị bạn gán mà không làm thay đổi gì tới các controls.
Nhấp chuột vào đây để mở rộng...
Anh cho em hỏi thêm , sao máy em báo lỗi này anh. mặc dù em đã khai báo

PHP: 
#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongPtr) As LongPtr
#Else
    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
#End If
1614933245125.png
 
Upvote 0
phuoclocvl đã viết:
Dạ, em hiểu rồi . Cảm ơn Anh!
Bài đã được tự động gộp:


Anh cho em hỏi thêm , sao máy em báo lỗi này anh. mặc dù em đã khai báo

PHP: 
#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongPtr) As LongPtr
#Else
    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
#End If
View attachment 254920
Nhấp chuột vào đây để mở rộng...
Do bạn không trích toàn bộ code nên tôi nghĩ là khai báo bị sai
Mã: 
Dim hWnd&
Nếu muốn phục vụ nhiều phiên bản, mà do bạn có #If Win64 Then ... #Else ... #End If nên tôi nghĩ là bạn muốn phục vụ nhiều phiên bản, thì phải là
Mã: 
#If ... Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
 
Upvote 0
batman1 đã viết:
Do bạn không trích toàn bộ code nên tôi nghĩ là khai báo bị sai
Mã: 
Dim hWnd&
Nếu muốn phục vụ nhiều phiên bản, mà do bạn có #If Win64 Then ... #Else ... #End If nên tôi nghĩ là bạn muốn phục vụ nhiều phiên bản, thì phải là
Mã: 
#If ... Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
Nhấp chuột vào đây để mở rộng...
dạ , để em thử lại coi đước hong. cảm ơn anh,
 
Upvote 0
Nguyễn Duy Tuân đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Nguyễn Duy Tuân đã viết:
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.
Nhấp chuột vào đây để mở rộng...

Nguyễn Duy Tuân đã viết:
zoomform.gif
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.
Nhấp chuột vào đây để mở rộng...
Xin chào anh Tuân!

Code Anh viết dùng để zoon userform Em thấy rất hay ạ. Tuy nhiên trong quá trình sử dụng em có gặp phải trở ngại khi dùng code này, có vẻ hơi lạc đề một tí nhưng Em mong Anh giải đáp giúp ạ:

Giả sử Em gán câu lệnh vào nút "ToggleButton1" như trong file như sau:

Private Sub ToggleButton1_Click()
Range("A1") = "ABC"
End Sub

Kết quả là khi nhấn nút ToggleButton1, Excel hiện thông báo ExcelApp_SheetChange như ảnh đính kèm. Anh Tuân cho em hỏi có cách nào để Excel cho phép thực hiện thay đổi lên sheet mà không hiện lên thông báo này nữa không ạ?
 

File đính kèm

  • ExcelApp_SheetChange.png
    ExcelApp_SheetChange.png
    131.6 KB · Đọc: 14
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
goodlife1605 đã viết:
Xin chào anh Tuân!

Code Anh viết dùng để zoon userform Em thấy rất hay ạ. Tuy nhiên trong quá trình sử dụng em có gặp phải trở ngại khi dùng code này, có vẻ hơi lạc đề một tí nhưng Em mong Anh giải đáp giúp ạ:

Giả sử Em gán câu lệnh vào nút "ToggleButton1" như trong file như sau:

Private Sub ToggleButton1_Click()
Range("A1") = "ABC"
End Sub

Kết quả là khi nhấn nút ToggleButton1, Excel hiện thông báo ExcelApp_SheetChange như ảnh đính kèm. Anh Tuân cho em hỏi có cách nào để Excel cho phép thực hiện thay đổi lên sheet mà không hiện lên thông báo này nữa không ạ?
Nhấp chuột vào đây để mở rộng...

Bạn có thể viết lệnh như sau:

Private Sub ToggleButton1_Click()
Application.EnableEvents = False

Range("A1") = "ABC"

Application.EnableEvents = True
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
Trả lời
15
Đọc
276
Phuocam
Phuocam
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
19K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
278
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
250
ptm0412
ptm0412
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
0
Đọc
35
dung09031989
dung09031989
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
1
Đọc
42
tranvansau278
T
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
0
Đọc
39
cherry0187
C
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
35
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
149
GPE-Trợ Lý
GPE-Trợ Lý
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
2
Đọc
79
phutdm
P
dunghtgiga
  • Đã khóa
Tính bốn tuần cho một tháng
Trả lời
9
Đọc
270
ptm0412
ptm0412
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
3
Đọc
103
HUONGHCKT
H
Mr Đạo
in giấy ra bị lệch xuống dưới
    • Thích
2
Trả lời
29
Đọc
26K
Hoàng Tuấn 868
H
H
Không xem được ảnh trên Excel
Trả lời
3
Đọc
1K
huyentran9292
H
T
Xin form quản lý dữ liệu học viên của Trung tâm Đào tạo
Trả lời
2
Đọc
222
hakiru188
H
C
Code Lọc Dữ Liệu
Trả lời
10
Đọc
175
Cúc Hr
C
Y
Cách ẩn công thức 1 ô trong sheet
Trả lời
8
Đọc
120
hoangminhtien
hoangminhtien
vuha
  • Question
Lỗi chọn dòng thứ 6 trong sheet được chọn: rows("6:6").select
Trả lời
12
Đọc
163
ptm0412
ptm0412
Nguyencaocuong86
Tô màu dữ liệu trùng lặp trong excel.
Trả lời
10
Đọc
145
Nguyencaocuong86
Nguyencaocuong86
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom