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,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:
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

T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
1
Đọc
20
DeTong
D
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
8
Đọc
929
thientac
T
A
[Cần Giúp] Excel nhiều người dùng cùng lúc
Trả lời
5
Đọc
105
hvnhpro
H
PhiTQ-ME
  • Question
Nhờ trợ giúp sửa VBA tính diễn giải khối lượng
Trả lời
9
Đọc
103
PhiTQ-ME
PhiTQ-ME
8
Hàm thống kê số lượng thành viên câu lạc bộ theo từng đợt tuyển thành viên
Trả lời
2
Đọc
56
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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