CÔNG TY CỔ PHẦN BLUESOFTS

/ Lập trình VBA / nâng cao level1 / Phóng to và thu nhỏ Userform và Controls Excel

Phóng to và thu nhỏ Userform và Controls Excel

Trong VBA. Tạo userform chúng ta muốn co giãn form và các controls bên trong tự phóng to lên hoặc thu nhỏ theo tỷ lệ form. Bình thường không làm được nhưng với phương pháp lập trình VBA, API và sử dụng thuộc tính Userform.Zoom chúng ta làm được việc này.

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

'****************************************
'Tac gia: Nguyen Duy Tuan
'Tel : 0904.210.337
'E.Mail :
tuanktcdcn@yahoo.com
'Website: www.bluesofts.net
'****************************************
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
Label3.ForeColor = vbBlue
Dim I&
For I = 1 To 12
ComboBox1.AddItem "Tháng " & I
ListBox1.AddItem "Tháng " & I
Next I
End Sub
'--------------------------------------------------------------------
Private Sub UserForm_Resize()
Dim tmpZoom&, CurStyle&
Dim tmpWidth As Double
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
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