Zoom Userform & Controls (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,845
Được thích
10,338
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

Chỉnh sửa lần cuối bởi điều hành viên:
Hay quá! Đúng là trên cả tuyệt vời! Cám ơn Anh Tuân nhiều!
 
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

Code hoàn chỉnh tôi gửi trong file đính kèm.
Không ngờ code lại đơn giản thế
Tuy nhiên nếu thiết lập trước cho UserForm với Height = 180 và Width =240 thì sẽ có 1 lỗi xuất hiện khi bấm nút MAX

untitled.JPG

Không biết là nguyên nhân gì
Nhưng theo thông báo thì chỉ Set được Zoom từ 10 đến 400. Trong khi nếu tính toán thì sẽ thấy thời điểm này Zoom đang > 400
Nhờ Tuấn chỉnh lại giúp (chắc có liên quan đến kích thước của từng màn hình đây! Tôi dùng Laptop với màn hình rộng)
Có thể sửa thành vầy chăng:
PHP:
Private Sub UserForm_Resize()
  Dim Tmp&
  Tmp = Round(Width / OldWidth * 100, 0)
  If Tmp > 400 Then Tmp = 400
  Zoom = Tmp
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mình có thêm mấy ý kiến nữa:
1> Thời điểm hiện tại chắc chẳng còn ai xài Office 97, vậy chắc cũng không cần đoạn If Val(Application.Version) < 9 Then làm gì. Viết luôn thành: hWnd = FindWindow("ThunderDFrame", Caption) cho gọn
2> Không biết tại sao phải cần sự kiện này:
PHP:
Private Sub UserForm_Terminate()
  SetWindowLong hWnd, GWL_STYLE, PrevStyle
End Sub
Ý tôi muốn nói nếu không Set Window về vị trí cũ thì có vấn đề gì không? (trước giờ tôi toàn bỏ luôn công đoạn này)
3> Code của Tuân chỉ tính đến chiều ngang (Width). Vậy nếu bắt buộc phải tính cả 2 chiều (Width và Height) thì phải làm sao?
 
Lần chỉnh sửa cuối:
Upvote 0
Mình có thêm mấy ý kiến nữa:
1> Thời điểm hiện tại chắc chẳng còn ai xài Office 97, vậy chắc cũng không cần đoạn If Val(Application.Version) < 9 Then làm gì. Viết luôn thành: hWnd = FindWindow("ThunderDFrame", Caption) cho gọn
2> Không biết tại sao phải cần sự kiện này:
PHP:
Private Sub UserForm_Terminate()
  SetWindowLong hWnd, GWL_STYLE, PrevStyle
End Sub
Ý tôi muốn nói nếu không Set Window về vị trí cũ thì có vấn đề gì không? (trước giờ tôi toàn bỏ luôn công đoạn này)
3> Code của Tuân chỉ tính đến chiều ngang (Width). Vậy nếu bắt buộc phải tính cả 2 chiều (Width và Height) thì phải làm sao?

Vấn đề 1. Đúng là còn ít người dùng Excel 97 rồi, em cố tình để nó có tính tổng quát cho mọi phiên bản Excel. Biết đâu ông Tây nào chưa có tiền mua Excel mới vẫn dùng 97 thì sao nhỉ :d

Vấn đề 2. Trong hoàn cảnh này đúng ra là không nhất thiết phải hoàn trả thiết lập cho form. Vì muốn nhắc nhở các bạn học lập trình là thay đổi cái gì, khi không dùng thì phải hoàn trả về cái ban đầu của nó. Đây là thói quen tốt! Âu cũng là quan điểm của em :).

Vấn đề 3. Vì khung hình của các controls ảnh hưởng của chiều rộng form nên lấy chiều rộng làm chuẩn, còn độ cao thì ít ảnh hưởng. Phiên bản tới đây em sẽ thiết lập cả chiều rộng và chiều cao theo tỷ lệ ban đầu của form khi Zoom nằm ngoài khoảng 10, 400

Tôi định làm khi kéo chiều rộng form thì chiều cao cũng thay đổi hoặc kéo chiều cao thì chiều rộng cũng thay đổi, không biết có cần thiết không? Các bạn chi ý kiến, nếu thấy cần làm vậy tôi sẽ làm.
 
Upvote 0
Đúng rồi đó anh Tuân, nếu thay đổi bất kỳ chiều nào, thì cả hai chiều giản ra tương ứng thì sẽ hay hơn.

@Thầy Ndu: Nếu bẫy 400 thì cũng nên bẫy 10 vậy.

PHP:
Private Sub UserForm_Resize()
  Dim Tmp&
  Tmp = Round(Width / OldWidth * 100, 0)
  If Tmp > 400 Then Tmp = 400
  If Tmp < 10 Then Tmp = 10
  Zoom = Tmp
End Sub
 
Upvote 0
Vấn đề 3. Vì khung hình của các controls ảnh hưởng của chiều rộng form nên lấy chiều rộng làm chuẩn, còn độ cao thì ít ảnh hưởng. Phiên bản tới đây em sẽ thiết lập cả chiều rộng và chiều cao theo tỷ lệ ban đầu của form khi Zoom nằm ngoài khoảng 10, 400

Tôi định làm khi kéo chiều rộng form thì chiều cao cũng thay đổi hoặc kéo chiều cao thì chiều rộng cũng thay đổi, không biết có cần thiết không? Các bạn chi ý kiến, nếu thấy cần làm vậy tôi sẽ làm.
Thật ra hỏi là để học thêm về các giải pháp thôi chứ với cái Form ấy, code ấy, tôi đánh giá là quá hoàn hảo rồi. Ăn tiền ở chổ chỉ cần chỉnh Zoom là mọi thứ sẽ zoom theo
 
Upvote 0
Nâng cấp phiên bản Zoom Userform & Controls

Xin gửi các thành viên phiên bản sửa lỗi của Zoom Userform & Controls

Cần thêm đoạn khai báo hằng số và khai báo biến
Mã:
Private Const ZoomMin = 10[COLOR="#008000"] 'VBA cho phép mức thấp nhất là 10[/COLOR]
Private Const ZoomMax = 400[COLOR="#008000"] 'VBA cho phép mức cao nhất là 400. [/COLOR]
Dim AllowResize As Boolean

Bạn có thể tự thay đổi giá trị của ZoomMin và ZoomMax trong pham vi 10-400. ví dụ bạn muốn form của bạn chỉ cho phép zoom thấp nhất là 50 và cao nhất là 200 thì thay
Mã:
Private Const ZoomMin = 50
Private Const ZoomMax = 200

Biến AllowResize để ngăn cản việc chạy lại sự kiện Resize khi thay đổi Width, Height của form trong code. AllowResize = True khi khởi tạo form.

Sựu kiện UserForm_Resize được thay đổi như sau

Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom As Long
    If Not AllowResize Then Exit Sub
    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 [COLOR="#008000"]'Điều chỉnh lại form khi kích cỡ ngoài khoảng ZoomMin, ZoomMax[/COLOR]
        [COLOR="#008000"]'Nếu không phải là phóng to form toàn màn hình thì điều chỉnh kích cõ form đúng tỷ lệ ban đầu[/COLOR]
        If Not (GetWindowLong(hWnd, GWL_STYLE) And WS_MAXIMIZE) = WS_MAXIMIZE Then
            AllowResize = False [COLOR="#008000"]'Ngăn không chạy UserForm_Resize khi đang thay đổi size[/COLOR]
            Width = tmpZoom * OldWidth / 100
            Height = Width * OldHeight / OldWidth
            AllowResize = True [COLOR="#008000"]'Cho phép resize[/COLOR]
        End If
    End If
    Zoom = tmpZoom [COLOR="#008000"]'Luôn phải đảm bảo  10<=Zoom<=400[/COLOR]
End Sub

Code hoàn chỉnh nằm trong file ở trang đầu.
 
Upvote 0
Nếu Dim tmpZoom As Long thì đâu cần phải Round(Width / OldWidth * 100, 0) phải không anh Tuân? Chỉ cần vầy là được Width / OldWidth * 100

Cho hỏi thêm, làm sao để Resize chiều rộng thì có thể tự chỉnh chiều cao tương ứng được ạ? Cảm ơn rất nhiều vì đã chia sẽ thuật toán trên diễn đàn ạ!

Mình được voi đòi tiên chứ cái Form này mình mơ cũng chưa nghĩ ra được! Kiểu viết code của anh Tuân thật độc đáo, những số liệu đều được thay thế bằng chữ, tuy thấy dài dòng văn tự nhưng thật ra rất dễ biết những thông số là cái gì, chừng vài tháng sau nhìn lại code cũng còn hiểu và nhớ mình làm gì! Em sẽ học theo cách trình bày code này! Cám ơn Anh.
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu Dim tmpZoom As Long thì đâu cần phải Round(Width / OldWidth * 100, 0) phải không anh Tuân? Chỉ cần vầy là được Width / OldWidth * 100

Cho hỏi thêm, làm sao để Resize chiều rộng thì có thể tự chỉnh chiều cao tương ứng được ạ? Cảm ơn rất nhiều vì đã chia sẽ thuật toán trên diễn đàn ạ!

Mình được voi đòi tiên chứ cái Form này mình mơ cũng chưa nghĩ ra được! Kiểu viết code của anh Tuân thật độc đáo, những số liệu đếu được thay thế bằng chữ, tuy thấy dài dòng văn tự nhưng thật ra rất dễ biết những thông số là cái gì, chừng vài tháng sau nhìn lại code cũng còn hiểu và nhớ mình làm gì! Em sẽ học theo cách trình bày code này! Cám ơn Anh.

Muốn lấy chiều cao tỷ lệ với chiều rộng ta viết code
Height = Width * OldHeight / OldWidth

Còn biến Long và Round thì đây lại là thói quen của mình :).
 
Upvote 0
Muốn lấy chiều cao tỷ lệ với chiều rộng ta viết code
Height = Width * OldHeight / OldWidth

Còn biến Long và Round thì đây lại là thói quen của mình :).


Em thấy có đoạn code đó trong form:

Mã:
        If Not (GetWindowLong(hWnd, GWL_STYLE) 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
        End If

Thế nhưng hình như nó không chạy hay sao đó anh. Còn nếu Height = Width * OldHeight / OldWidth mà để ra ngoài thì lỗi liền khi Max/Min vì nó không cho thay đổi kích cỡ khi đang Max/Min.
 
Upvote 0
Em thấy rằng khi Form đang Min, thì Height của nó bằng 19.5 thôi vì thế em nghĩ nên làm như vầy (kiểu nông dân làm máy bay ấy mà):

PHP:
Private Sub UserForm_Resize()
    Dim tmpZoom As Long, MinHeight As Long
    MinHeight = 20
    If Not AllowResize Then Exit Sub
    tmpZoom = Width / OldWidth * 100
    If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
    If tmpZoom > ZoomMax Then tmpZoom = ZoomMax
    If Height <= MinHeight Then Exit Sub
    If Not (GetWindowLong(hWnd, GWL_STYLE) 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
    End If
    Zoom = tmpZoom
End Sub

Như vậy thì mình kéo ra, vào đều chạy ổn định.
 
Lần chỉnh sửa cuối:
Upvote 0
Em thấy có đoạn code đó trong form:

Mã:
        If Not (GetWindowLong(hWnd, GWL_STYLE) 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
        End If

Thế nhưng hình như nó không chạy hay sao đó anh. Còn nếu Height = Width * OldHeight / OldWidth mà để ra ngoài thì lỗi liền khi Max/Min vì nó không cho thay đổi kích cỡ khi đang Max/Min.

Chạy đấy. Nó là kiểm tra form có phải trạng thái Max không thì mới cho phép chạy lệnh bên trong. Mình kiểm tra kỹ rồi.

Còn muốn nó thay đổi khi resize thì gán ở đoạn khác.

Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom As Long
    If Not AllowResize Then Exit Sub
    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 (GetWindowLong(hWnd, GWL_STYLE) 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 (GetWindowLong(hWnd, GWL_STYLE) And WS_MAXIMIZE) = WS_MAXIMIZE Then
        Height = Width * OldHeight / OldWidth
    End If[/COLOR]
    Zoom = tmpZoom
End Sub

Theo mình thì không nên tự lấy Height vì đôi khi người dùng tự thay đổi chiều cao của form cho phù hợp với danh sách mã hàng bên dưới chẳng hạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Chạy đấy. Nó là kiểm tra form có phải trạng thái Max không thì mới cho phép chạy lệnh bên trong. Mình kiểm tra kỹ rồi.

Còn muốn nó thay đổi khi resize thì gán ở đoạn khác.

Em lại kiểm tra thêm rằng, nếu tmpZoom As Long được thay bằng tmpZoom As Double và đừng dùng hàm Round thì Form nó Zoom mượt mà hơn vì hình như phần thập phân nó cũng được tính.
 
Upvote 0
Em lại kiểm tra thêm rằng, nếu tmpZoom As Long được thay bằng tmpZoom As Double và đừng dùng hàm Round thì Form nó Zoom mượt mà hơn vì hình như phần thập phân nó cũng được tính.

Không phải thế đâu, có thể cảm giác của bạn thôi. Zoom chỉ nhận giá trị nguyên. Mình vẫn dùng hàm Round vì nó đúng với mọi ngôn ngữ khác. Những người lập trình VB ban đầu thường không để ý kỹ kiểu dữ liệu (phó mặc cho VB tự nhận và chạy), sau này gặp nhiều rắc rối.
 
Upvote 0
Chạy đấy. Nó là kiểm tra form có phải trạng thái Max không thì mới cho phép chạy lệnh bên trong. Mình kiểm tra kỹ rồi.

Còn muốn nó thay đổi khi resize thì gán ở đoạn khác.

Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom As Long
    If Not AllowResize Then Exit Sub
    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 (GetWindowLong(hWnd, GWL_STYLE) 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 (GetWindowLong(hWnd, GWL_STYLE) And WS_MAXIMIZE) = WS_MAXIMIZE Then
        Height = Width * OldHeight / OldWidth
    End If[/COLOR]
    Zoom = tmpZoom
End Sub

Theo mình thì không nên tự lấy Height vì đôi khi người dùng tự thay đổi chiều cao của form cho phù hợp với danh sách mã hàng bên dưới chẳng hạn.

Anh ơi, gán đoạn đó vô sẽ bị lỗi khi Min đấy ạ!

cứ như kiểu củ chuối của em thì lại hiệu quả!

Mã:
Private Sub UserForm_Resize()
    Dim tmpZoom As Double, MinHeight As Double
   [COLOR=#0000cd] MinHeight = 20[/COLOR]
    If Not AllowResize Then Exit Sub
    tmpZoom = Width / OldWidth * 100
    If tmpZoom < ZoomMin Then tmpZoom = ZoomMin
    If tmpZoom > ZoomMax Then tmpZoom = ZoomMax
    [COLOR=#0000cd]If Height <= MinHeight Then Exit Sub[/COLOR]
    If Not (GetWindowLong(hWnd, GWL_STYLE) 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
    End If
    Zoom = tmpZoom
End Sub
 
Upvote 0
Không phải thế đâu, có thể cảm giác của bạn thôi. Zoom chỉ nhận giá trị nguyên. Mình vẫn dùng hàm Round vì nó đúng với mọi ngôn ngữ khác. Những người lập trình VB ban đầu thường không để ý kỹ kiểu dữ liệu (phó mặc cho VB tự nhận và chạy), sau này gặp nhiều rắc rối.

Về chuyên môn thì em không dám bàn với anh, nhưng em đã thử 2 cái và nhận thấy nếu dùng Long kết hợp với Round trong trường hợp này thì form khi kéo giản nó giựt giựt và giống như Repaint màn hình vậy, còn để lại những vệt rất nhanh, không chụp hình lại được chứ không em gửi cho anh xem. Còn không dùng thì không hề có chuyện này!

Có lẽ do máy anh mạnh nên không thấy sự khác biệt, còn máy yếu sẽ thấy điều đó. Song, em nghĩ nên thiết kế mà chạy được trên máy yếu thì máy mạnh là vô tư rồi đúng không anh. Hihihi

CÁM ƠN ANH RẤT NHIỀU!!!
 
Lần chỉnh sửa cuối:
Upvote 0
Về chuyên môn thì em không dám bàn với anh, nhưng em đã thử 2 cái và nhận thấy nếu dùng Long kết hợp với Round trong trường hợp này thì form khi kéo giản nó giựt giựt và giống như Repaint màn hình vậy, còn để lại những vệt rất nhanh, không chụp hình lại được chứ không em gửi cho anh xem. Còn không dùng thì không hề có chuyện này!

Có lẽ do máy anh mạnh nên không thấy sự khác biệt, còn máy yếu sẽ thấy điều đó. Song, em nghĩ nên thiết kế mà chạy được trên máy yếu thì máy mạnh là vô tư rồi đúng không anh. Hihihi

CÁM ƠN ANH RẤT NHIỀU!!!

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
 
Upvote 0
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.
Chắc là vậy rồi, vì tôi đã thử và không thấy có sự khác biệt khi biến là Double và không dùng ROUND so với khi biến là Long
Trong Help của Excel rõ ràng viết rằng:
Chắc Nghĩa.. cảm giác thôi!
 
Upvote 0
Chắc là vậy rồi, vì tôi đã thử và không thấy có sự khác biệt khi biến là Double và không dùng ROUND so với khi biến là Long
Trong Help của Excel rõ ràng viết rằng:

Chắc Nghĩa.. cảm giác thôi!

Bằng mắt thường cũng cảm nhận được mà Anh Tuân:

Code chạy ban đầu là double, nhìn có vẽ mịn màng hơn, không có vệt hoặc rất ít, còn code sau chạy Long, thấy rất là rõ những vệt trắng, xanh khi resize.

[video=youtube;s-9_oUFazdI]http://www.youtube.com/watch?v=s-9_oUFazdI[/video]
 
Lần chỉnh sửa cuối:
Upvote 0
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

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
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?


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: 17
  • MAN HINH 21 INCHES.jpg
    MAN HINH 21 INCHES.jpg
    20.8 KB · Đọc: 13
  • M146 (B283243A).xlsm
    M146 (B283243A).xlsm
    81.4 KB · Đọc: 42
Upvote 0
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.

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
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.


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

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
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.
Dạ, em hiểu rồi . Cảm ơn Anh!
Bài đã được tự động gộp:

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.
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
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
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
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
dạ , để em thử lại coi đước hong. cảm ơn anh,
 
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.
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.

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.
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: 16
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
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 ạ?

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ài viết mới nhất

Back
Top Bottom