返回列表 上一主題 發帖

[發問] Userform最大化(且內容比例自動放大?)

本帖最後由 GBKEE 於 2015-5-18 10:05 編輯

回復 9# PKKO
試試看自己縮放.
這表單的程式碼
  1. Option Explicit
  2. Dim X As Double, Y As Double, e As Control
  3. Private Sub UserForm_Initialize()  '表單初始化的程式
  4.     Dim e As Control
  5.     X = Width
  6.     Y = Height
  7.     For Each e In Me.Controls
  8.         e.Tag = e.Top & "," & e.Left & "," & e.Width & "," & e.Height & "," & e.Font.Size
  9.     Next
  10. End Sub
  11. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  12. '發生在當使用者按了滑鼠鍵時。MouseDown 發生於使用者按下滑鼠鍵****
  13.     Dim xZoom As Double
  14.     If Shift = 2 Then           'Ctrl 鍵
  15.         Select Case Button      '滑鼠
  16.             Case 1              '按下左滑鼠鍵。: 放大
  17.                 xZoom = 1.2     '放大 %2
  18.             Case 2              '按下右滑鼠鍵。: 縮小
  19.                 xZoom = 0.8     '所小 %2
  20.         End Select
  21.         Zoom_UserForm xZoom     '表單縮放程式
  22.     ElseIf Shift = 1 Then       'Shift 鍵 +任一滑鼠按鍵
  23.         Revert_UserForm         '表單還原原本大小
  24.     End If
  25. End Sub
  26. Private Sub Zoom_UserForm(xZoom As Double)  '表單縮放
  27.     Width = Width * xZoom
  28.     Height = Height * xZoom
  29.     For Each e In Controls
  30.         With e
  31.             .Top = .Top * xZoom
  32.             .Left = .Left * xZoom
  33.             .Width = .Width * xZoom
  34.             .Height = .Height * xZoom
  35.             .Font.Size = .Font.Size * xZoom
  36.         End With
  37.     Next
  38. End Sub
  39. Private Sub Revert_UserForm() '表單還原原本大小
  40.     Dim xTag As Variant
  41.     Width = X
  42.     Height = Y
  43.     For Each e In Me.Controls
  44.         With e
  45.             xTag = Split(.Tag, ",")
  46.             .Top = xTag(0)
  47.             .Left = xTag(1)
  48.             .Width = xTag(2)
  49.             .Height = xTag(3)
  50.             .Font.Size = xTag(4)
  51.         End With
  52.     Next
  53. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 10# GBKEE
表單最大化
  1. Option Explicit
  2. Private Sub UserForm_Initialize()  '表單初始化的程式
  3.     Dim e As Control
  4.     For Each e In Me.Controls
  5.         e.Tag = e.Top & "," & e.Left & "," & e.Width & "," & e.Height & "," & e.Font.Size
  6.     Next
  7.     Form_xlMax
  8. End Sub
  9. Private Sub Form_xlMax() '表單最大化
  10.     Dim xlMax As Double, ylMax As Double, xZoom As Double
  11.     Dim e As Control
  12.     With Application
  13.         .WindowState = xlMaximized
  14.         xlMax = .Width
  15.         ylMax = .Height
  16.     End With
  17.     xZoom = 1
  18.     Do While Width < xlMax
  19.         Width = Width * xZoom
  20.         Height = Height * xZoom
  21.         For Each e In Controls
  22.             With e
  23.                 .Top = .Top * xZoom
  24.                 .Left = .Left * xZoom
  25.                 .Width = .Width * xZoom
  26.                 .Height = .Height * xZoom
  27.                 .Font.Size = .Font.Size * xZoom
  28.                Debug.Print xZoom, .Font.Size
  29.             End With
  30.         Next
  31.         xZoom = xZoom * 1.0000654
  32.     Loop
  33.     Top = 0
  34.     Left = 0
  35. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# PKKO

10# 的程式碼
放大: 鍵盤Ctrl 鍵 + 按下左滑鼠鍵
縮小: 鍵盤Ctrl 鍵 + 按下右滑鼠鍵
還原: 鍵盤Shift鍵 +按下滑鼠任一鍵
  1. If Shift = 2 Then           'Ctrl 鍵
  2.         Select Case Button      '滑鼠
  3.             Case 1              '按下左滑鼠鍵。: 放大
  4.                 xZoom = 1.2     '放大 %2
  5.             Case 2              '按下右滑鼠鍵。: 縮小
  6.                 xZoom = 0.8     '縮小 %2
  7.         End Select
  8.        Zoom_UserForm xZoom     '表單縮放程式
  9.     ElseIf Shift = 1 Then       'Shift 鍵 +任一滑鼠按鍵
  10.         Revert_UserForm         '表單還原原本大小
  11.     End If
複製代碼
11#的程式碼
表單開啟自動最大化
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2015-5-20 14:00 編輯

回復 19# PKKO
直接放大
  1. Option Explicit
  2. Dim Form_Tag As Variant
  3. Private Sub UserForm_Initialize()  '表單初始化的程式
  4.     Dim e As Control
  5.     Form_Tag = Split(Top & "," & Left & "," & Width & "," & Height & "," & Font.Size, ",")
  6.     Form_xlMax
  7. End Sub
  8. Private Sub Form_xlMax() '表單最大化
  9.     Dim xZoom As Double, yZoom As Double, e As Control
  10.     With Application
  11.         .WindowState = xlMaximized
  12.         xZoom = .Width / Form_Tag(2)    '寬放大的比例
  13.         yZoom = .Height / Form_Tag(3)   '高放大的比例
  14.     End With
  15.     Top = 0
  16.     Left = 0
  17.     Width = Width * xZoom
  18.     Height = Height * yZoom
  19.     For Each e In Controls
  20.         With e
  21.             .Top = .Top * xZoom
  22.             .Left = .Left * xZoom
  23.             .Width = .Width * xZoom
  24.             .Height = .Height * yZoom
  25.             .Font.Size = .Font.Size * xZoom
  26.         End With
  27.     Next
  28. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 GBKEE 於 2015-5-22 06:42 編輯

回復 24# PKKO
導致工作列的位置會蓋掉userform的顯示
不過不打緊,userfrom最下方不要放元件就好!

這樣可以嗎?
  1. Option Explicit
  2. Dim Form_Tag As Variant
  3. Private Sub UserForm_Activate()
  4.     Form_xlMax
  5. End Sub
  6. Private Sub Form_xlMax() '表單最大化
  7.     Dim xZoom As Double, yZoom As Double, e As Control
  8.     With Application
  9.         .WindowState = xlMaximized
  10.         xZoom = .Width / Me.Width     '寬放大的比例
  11.         '****************
  12.         yZoom = .Height / (Me.Height + 20)  '高放大的比例
  13.         '****************
  14.     End With
  15.     Top = 0
  16.     Left = 0
  17.     Width = Width * xZoom
  18.     Height = Height * yZoom
  19.     For Each e In Controls
  20.         With e
  21.             .Top = .Top * xZoom
  22.             .Left = .Left * xZoom
  23.             .Width = .Width * xZoom
  24.             .Height = .Height * yZoom
  25.             .Font.Size = .Font.Size * yZoom
  26.         End With
  27.     Next
  28. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 屋寬不如心寬。
返回列表 上一主題