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

PKKO

小弟已知Userform 最大化的程式碼,也知道依比率放大的程式碼,但不知道如何自動取得兩者之間的比率,來自動設定放大的倍數...
有人知道zoom的比率要如何求得嗎?

比率的程式碼
UserForm1.Zoom = 125

最大化的程式碼

1. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   
2. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   
3. Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
   
4. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
   
5. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
6. Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
   
7. Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
   
8. Private Const WS_MAXIMIZEBOX = &H10000
   
9. Private Const WS_MINIMIZEBOX = &H20000
   
10. Private Const GWL_STYLE = (-16)
    
11. Private Const SW_SHOWMAXIMIZED = 3
    
12. Private Const SW_SHOWNORMAL = 1
    
13. Private Const SW_SHOWMINIMIZED = 2
    
14. Private Const WS_THICKFRAME = &H40000
    
15. Const SM_CXFULLSCREEN = 16
    
16. Const SM_CYFULLSCREEN = 17
    
17. Const HWND_TOPMOST = -1
    
18. Const SWP_SHOWWINDOW = &H40
    
19. Dim hWndForm As Long
    
20. Dim IStyle As Long
    
21. 
    
22. Private Sub UserForm_Initialize()
    
23.   hWndForm = FindWindow("ThunderDFrame", Me.Caption)
    
24.   IStyle = GetWindowLong(hWndForm, GWL_STYLE)
    
25.   IStyle = IStyle Or WS_THICKFRAME
    
26.   IStyle = IStyle Or WS_MINIMIZEBOX
    
27.   IStyle = IStyle Or WS_MAXIMIZEBOX
    
28.   SetWindowLong hWndForm, GWL_STYLE, IStyle
    
29. End Sub
    
30. 
    
31. Public Sub myShowMax()
    
32.    
    
33.     SetActiveWindow hWndForm
    
34.     ShowWindow hWndForm, SW_SHOWMAXIMIZED
    
35. End Sub

複製代碼

lichang

謝謝大大們的教導，解決了到2021年使用win10 縮放比例把表格滿到螢幕外面的問題，謝謝喔!!

s13030029

回復 34# bobomi
請問目前我的userform用你的程式可以讓使用者自由縮放，但是要怎樣才能讓 image 物件也能跟著縮放???

詳細內容在這裡

bobomi

1.zip (50.81 KB)

下載次數: 7

2015-5-24 22:01

目前發現有一個問題
例如:
用滑鼠典擊  UserForm  使其最大化後
滑鼠移到工具列去點擊那個 EXCEL 圖示
EXCEL 整各會匯縮小到工具列 (這部分是正常的 )
再次點擊那個 EXCEL 圖示 , EXCEL 就會還原變大 (這部分也是正常的 )
問題來了
當 EXCEL 還原變大時
EXCEL 會多事的把  處於 最大化的 UserForm  自動調回一搬大小

這個暫時解決不了

PKKO

回復 32# bobomi


    大大,新版的使用上怪怪的

在切換不同表單的時候
下方程式碼的地方會無法執行

1. Private Sub UserForm_Activate()
   
2.   modForm.UserForm_SetButton Me
   
3. End Sub

複製代碼

bobomi

(1) 文字原本顯示四個字,只有出現三個字,現在也可自行靠拉寬一點就顯示出來正確比例,所以四個字都可以顯示
     ->  我預設就是文字只有拉高才縮放, 拉寬則不縮放,  現在已經改成拉寬也會縮放
(2) 修正原作工作列看不到圖示

1.zip (48.15 KB)

下載次數: 8

2015-5-23 19:45

PKKO

回復 27# bobomi


    大大您好,前一篇的問題我都找到答案了,在SaveSetting ThisWorkbook.Name, "SSS"=>全部的USERFORM都指向同一個名稱即可n個表單都相同大小
另外還有一個問題(抱歉,問題很多...)

就是縮小按鈕會出現錯誤,不能縮小
我目前作法是將縮小按鈕沒得點,有辦法讓他不會出現錯誤,然後縮小到工作列,等到要用的時候再點一下工作列的檔案就會自動跳出原本大小的表單嗎?

1. ocx.Left = ocx_xy(0) * Rw
   
2. ocx.Top = ocx_xy(1) * Rh
   
3. ocx.Width = ocx_xy(2) * Rw
   
4. ocx.Height = ocx_xy(3) * Rh

複製代碼

錯誤發生在上方的height那邊

PKKO

回復 27# bobomi


    大大,我只能說您太神了!
這個自己拉的方式非常棒!
優點如下:
一、比妳之前的只有拉高度才會變更比例的好
二、可以有儲存功能
三、比例即便有問題也可以解決(文字原本顯示四個字,只有出現三個字,現在也可自行靠拉寬一點就顯示出來正確比例,所以四個字都可以顯示)

目前嘗試之後發現以下問題
1.若是有變更ListBox並且,自動調整欄位時,程式碼會崩潰在下方開頭的位置

1. ocx.Left = ocx_xy(0) * Rw
   
2. ocx.Top = ocx_xy(1) * Rh
   
3. ocx.Width = ocx_xy(2) * Rw
   
4. ocx.Height = ocx_xy(3) * Rh

複製代碼

A:我目前已有簡陋的解決方式,在啟動更新listBox 的時候checkUpdate = True
然後在Private Sub UserForm_Layout() 的第一行輸入    If checkUpdate = True Then checkUpdate = False: Exit Sub
這樣更新listBox的時候就不會執行,等到listbox結束之後他又會再更新一次畫面就OK了,因次第一個問題得到一個完美但簡陋的解決方式
附上我自己寫的listbox 快速使用程式碼

1. Function LIST顯示(UserForm, LISTBOX, RNG)
   
2.         checkUpdate = True
   
3.         '將資料顯示在LISTBOX 上
   
4.         LISTBOX.ColumnCount = UBound(RNG, 2)
   
5.         LISTBOX.List = RNG 'ListBox 的顯示方式
   
6.         '自動調整的程式
   
7.         '新增以下code
   
8.         Dim sWidth As String, dTotal As Double
   
9.         Dim oTemp As Object
   
10.         
    
11.         Set oTemp = UserForm.Controls.Add("Forms.TextBox.1")
    
12.         With oTemp
    
13.           .AutoSize = True'在這行程式碼的地方會啟動Private Sub UserForm_Layout()導致錯誤
    
14.           .MultiLine = True
    
15.           .WordWrap = False
    
16.           .SelectionMargin = False
    
17.           .Font.Name = LISTBOX.Font.Name
    
18.           .Font.Size = LISTBOX.Font.Size
    
19.         End With
    
20.         
    
21.         For j = 0 To LISTBOX.ColumnCount - 1
    
22.           oTemp.Text = ""
    
23.           For i = 0 To LISTBOX.ListCount - 1
    
24.             oTemp.Text = oTemp.Text & LISTBOX.List(i, j) & vbCr
    
25.           Next
    
26.           dTotal = dTotal + oTemp.Width
    
27.           sWidth = sWidth & oTemp.Width + 10 & ";"
    
28.         Next
    
29.         UserForm.Controls.Remove oTemp.Name
    
30.         LISTBOX.ColumnWidths = sWidth
    
31. End Function

複製代碼

2.若我有4個userForm,要如何自動存取同一個GetSetting、SaveSetting,讓四個視窗的大小都會相同
A:目前我還在研究這個部分

PKKO

回復 26# GBKEE

超版大大,確實視窗已經到工作列上方了

可是...
1.比例不對,原本對齊在水平線上的兩個元件,會變成一上一下
2.雖然視窗跑到工作列上方了,可是內容並沒有壓縮,導致原本要顯示的元件,無法顯示出來(被邊界卡掉了)

stillfish00

回復 28# bobomi
原來 VBA 有GetSetting、SaveSetting 可以存取註冊表
學到了~

下載 (56.94 KB)

2015-5-22 14:12