返回列表 上一主題 發帖

Excel VBA 如何自動調整表單大小

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-7-17 14:31 | 只看該作者

Excel VBA 如何自動調整表單大小

調整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
複製代碼
有其他解決方式
可以解答我的疑惑呢? 感激不盡 >//<
收藏 分享
Jared

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
2#
發表於 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
複製代碼

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
3#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 2013-7-17 17:07 | 只看該作者
回復 3# GBKEE
太好了，我還一直在想操作太多次字型可能會變掉。
還原是個好主意！

TOP

sunnyso

帖子
605 
主題
92 
精華
0 
積分
648 
點名
0  
作業系統
windows 
軟體版本
7 
閱讀權限
50 
性別
男 
來自
macau 
註冊時間
2013-4-5 
最後登錄
2019-2-10 

熱烈參與勳章好學求知勳章
5#
發表於 2013-7-17 21:09 | 只看該作者
回復 3# GBKEE

感謝，實用
ss

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
6#
發表於 2013-7-19 09:16 | 只看該作者
回復 3# GBKEE

感謝大大的幫忙，又學到了一招
Jared

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
7#
發表於 2013-7-19 09:20 | 只看該作者
回復 2# stillfish00

果然表單太複雜也不行，但還是感謝大大幫忙^^
Jared

TOP

Jared

帖子
103 
主題
30 
精華
0 
積分
139 
點名
0  
作業系統
wondows XP 
軟體版本
office 2007 
閱讀權限
20 
性別
男 
來自
彰化 
註冊時間
2013-2-21 
最後登錄
2015-6-26 
8#
發表於 2013-7-19 09:36 | 只看該作者
回復 3# GBKEE


    試了一下，如果要還原是要按哪個按鍵？>\<
Jared

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 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說明
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 手心向下是助人，手心向上是求人；助人快樂，求人痛苦。
返回列表 上一主題