You are here:: Phóng to và thu nhỏ Userform và Controls trong Excel VBA
 
 

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

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 : 
  Địa chỉ email này đã được bảo vệ từ spam bots, bạn cần kích hoạt Javascript để xem nó.
 
'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 

Download mã nguồn

Tác giả: Nguyễn Duy Tuân - Công ty Cổ phần Bluesofts

Các bạn tham khảo thông tin khóa học "Lập trình VBA trong Excel cơ bản" của Bluesofts tại đây