窗体及其控件同比例缩放

一指禅62

1. Option Explicit
   
2. Dim frmW, frmH
   
3. Dim i
   
4. 
   
5. Private Sub Form_Load()
   
6. If WindowState <> vbMaximized Then
   
7. frmW = Me.Width
   
8. frmH = Me.Height
   
9. End If
   
10. For i = 0 To Ms1.Cols - 1
    
11. Ms1.ColWidth(i) = Int((Ms1.Width - 360) / Ms1.Cols)
    
12. Next
    
13. End Sub
    
14. 
    
15. Private Sub Form_Resize()
    
16. On Error Resume Next
    
17. If frmW = 0 Or frmH = 0 Then Exit Sub
    
18. Dim c As Control, x, y
    
19. x = Me.Width / frmW
    
20. y = Me.Height / frmH
    
21. For Each c In Me.Controls
    
22. With c
    
23. .Left = Int(.Left * x)
    
24. .Top = Int(.Top * y)
    
25. .Width = Int(.Width * x)
    
26. .Height = Int(.Height * y)
    
27. End With
    
28. Next
    
29. For i = 0 To Ms1.Cols - 1
    
30. Ms1.ColWidth(i) = Int(Ms1.ColWidth(i) * x)
    
31. Next
    
32. frmW = Me.Width
    
33. frmH = Me.Height
    
34. End Sub

复制代码

vba 的 UserForm_Initialize 事件

1. Private Sub UserForm_Initialize()
   
2. Dim k As Object, x, y
   
3. With Application
   
4. .WindowState = xlMaximized
   
5. x = .Width / Me.Width
   
6. y = .Height / Me.Height
   
7. For Each k In Me.Controls
   
8. k.Move k.Left * x, k.Top * y, k.Width * x, k.Height * y
   
9. Next
   
10. Me.Move .Left, .Top, .Width, .Height
    
11. End With
    
12. End Sub
    

复制代码

ydlpc

赶紧占楼。明天用  谢楼主

kings12333

非常实用的事例 。。。

xiaoma302135

收藏学习一下，谢谢分享！

清风水月

收藏学习一下，谢谢分享！

gbr123456789

控件缩放，字体不变

mengyang0

学到了，我用hight方法总是，没法成比例变化

nengmuch

言简意赅，自己改改就能用

hnyeke

很实用的。

xdychina1

比较实用的代码