26/08/2019

Resize controls khi userform phóng to thu nhỏ

Code này của Tác Giả: Nguyễn Duy Tuân - DĐ GPE, cho phép chúng ta phóng to thu nhỏ đối tượng trong form tự động khi người dùng phóng to thu... thumbnail 1 summary

Code này của Tác Giả: Nguyễn Duy Tuân - DĐ GPE, cho phép chúng ta phóng to thu nhỏ đối tượng trong form tự động khi người dùng phóng to thu nhỏ form



Code:

Private Const ZoomMin = 10
Private Const ZoomMax = 400

Public hWnd&, PrevStyle&
Dim OldWidth As Double, OldHeight As Double
Dim AllowResize As Boolean

Private Sub UserForm_Activate()
ShowWindow hWnd, SW_MAXIMIZE
End Sub

Private Sub UserForm_Initialize()
AllowResize = True
OldWidth = Width
OldHeight = Height
If Val(Application.Version) < 9 Then
hWnd = FindWindow("ThunderXFrame", Caption) 'XL97
Else
hWnd = FindWindow("ThunderDFrame", Caption) 'XL2000
End If

PrevStyle = GetWindowLong(hWnd, GWL_STYLE)
SetWindowLong hWnd, GWL_STYLE, PrevStyle _
Or WS_SIZEBOX _
Or WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX
End Sub

Private Sub UserForm_Terminate()
SetWindowLong hWnd, GWL_STYLE, PrevStyle
End Sub

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

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
AllowResize = True 'Cho phep resize
Zoom = tmpZoom
End Sub







===================================================
Để trao đổi và hỏi đáp thêm về chủ đề này, vui lòng truy cập vào diễn đàn các bạn nhé https://thuthuataccess.com/forum/forum-21.html

2 nhận xét

  1. Lỗi luôn, Tải File Demo về xem cũng chẳng có gì

    Trả lờiXóa
    Trả lời
    1. Bên mình vẫn ok mà bạn. Có lẽ bạn chưa enable excel các phần bị protect thôi

      Xóa