Board logo

標題: Excel VBA 如何自動調整表單大小 [打印本頁]
作者: Jared    時間: 2013-7-17 14:31     標題: Excel VBA 如何自動調整表單大小

想請問一下大大
之前VBA表單寫好後
本身表單要填寫的內容較多
以目前一般22吋螢幕看還OK
但是換到筆電上面
發現表單開啟後
最下面的按鍵就按不到了
有辦法利用滑鼠將表單大小等比縮小嗎?

因為我利用按鍵縮小
改變了表單大小
但是內容沒有等比縮小
  1. Sub 設定自訂表單的尺寸()
  2. MsgBox “將UserForm1的高度與寬度各放大1.5倍”
  3. takasa = UserForm1.Height
  4. haba = UserForm1.Width
  5. UserForm1.Height = takasa * 3/2
  6. UserForm1.Width = haba * 3/2
  7. UserForm1.Show
  8. MsgBox “回復原來的狀態”
  9. UserForm1.Height = takasa
  10. UserForm1.Width = haba
  11. End Sub
複製代碼
有其他解決方式
可以解答我的疑惑呢? 感激不盡 >//<
作者: stillfish00    時間: 2013-7-17 15:22

回復 1# Jared
提供一個方法，根據表單的複雜度，效果可能不一定很好，供你參考：
在該表單的程式碼加上下面Code，開啟表單後，在表單上按：
Ctrl+滑鼠左鍵拖曳向上，可放大表單
Ctrl+滑鼠左鍵拖曳向下，可縮小表單
  1. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  2.   Static lastY As Single
  3.   
  4.   If Button = 1 And Shift = 2 Then
  5.     If Y - lastY > 5 Then
  6.       ResizeUserform 1.1
  7.       lastY = Y
  8.     ElseIf lastY - Y > 5 Then
  9.       ResizeUserform 0.9
  10.       lastY = Y
  11.     End If
  12.   End If
  13. End Sub

  15. Private Sub ResizeUserform(dSizeCoeff As Double)
  16.   Dim c  
  17.   With Me
  18.     .Width = .Width * dSizeCoeff
  19.     .Height = .Height * dSizeCoeff
  20.    
  21.     For Each c In .Controls
  22.       With c
  23.         .Top = .Top * dSizeCoeff
  24.         .Left = .Left * dSizeCoeff
  25.         .Width = .Width * dSizeCoeff
  26.         .Height = .Height * dSizeCoeff
  27.         
  28.         On Error Resume Next
  29.         .Font.Size = .Font.Size * dSizeCoeff
  30.         On Error GoTo 0
  31.       End With
  32.     Next
  33.   End With
  34. End Sub
複製代碼
作者: GBKEE    時間: 2013-7-17 16:56

回復 2# stillfish00
加上可還原(原來的大小)
  1. Option Explicit
  2. Dim xME()
  3. Private Sub UserForm_Initialize()
  4.     Dim i As Integer, e As Variant
  5.     ReDim xME(0 To Controls.Count)   
  6.     xME(0) = Array(Top, Left, Height, Width, Font.Size)
  7.     For Each e In Controls
  8.         With e
  9.             i = i + 1
  10.             xME(i) = Array(.Top, .Left, .Height, .Width, .Font.Size)
  11.         End With
  12.     Next
  13. End Sub
  14. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  15.   Dim i As Integer, e As Variant
  16.   Static lastY As Single
  17.   Debug.Print Shift
  18.     If Button = 1 And Shift = 2 Then
  19.         If Y - lastY > 5 Then
  20.             ResizeUserform 1.1
  21.             lastY = Y
  22.         ElseIf lastY - Y > 5 Then
  23.             ResizeUserform 0.9
  24.             lastY = Y
  25.         End If
  26.     ElseIf Button = 2 And Shift = 2 Then    '按下右鍵
  27.         Top = xME(0)(0)
  28.         Left = xME(0)(1)
  29.         Height = xME(0)(2)
  30.         Width = xME(0)(3)
  31.         Font.Size = xME(0)(4)
  32.         For Each e In Controls
  33.             With e
  34.                 i = i + 1
  35.                 .Top = xME(i)(0)
  36.                 .Left = xME(i)(1)
  37.                 .Height = xME(i)(2)
  38.                 .Width = xME(i)(3)
  39.                 .Font.Size = xME(i)(4)
  40.             End With
  41.         Next
  42.     End If
  43. End Sub
複製代碼
作者: stillfish00    時間: 2013-7-17 17:07

回復 3# GBKEE
太好了，我還一直在想操作太多次字型可能會變掉。
還原是個好主意！
作者: sunnyso    時間: 2013-7-17 21:09

回復 3# GBKEE

感謝，實用
作者: Jared    時間: 2013-7-19 09:16

回復 3# GBKEE

感謝大大的幫忙，又學到了一招
作者: Jared    時間: 2013-7-19 09:20

回復 2# stillfish00

果然表單太複雜也不行，但還是感謝大大幫忙^^
作者: Jared    時間: 2013-7-19 09:36

回復 3# GBKEE


    試了一下，如果要還原是要按哪個按鍵？>\<
作者: GBKEE    時間: 2013-7-19 09:44

本帖最後由 GBKEE 於 2013-7-19 09:45 編輯

回復 8# Jared
Shift   
0 (零) 沒有鍵
1 SHIFT 鍵
2 CTRL 鍵
4 ALT 鍵
  1. If Button = 1 And Shift = 2 Then    '按下左鍵 +Shift

  3.     ElseIf Button = 2 And Shift = 2 Then    '按下右鍵 +Shift
複製代碼
程式碼不了解要多看VBA說明



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)