麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] Userform最大化(且內容比例自動放大?) [打印本頁]

作者: PKKO 時間: 2015-5-13 17:45 標題: Userform最大化(且內容比例自動放大?)

本帖最後由 PKKO 於 2015-5-13 17:47 編輯

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

比率的程式碼
UserForm1.Zoom = 125

最大化的程式碼

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
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const WS_THICKFRAME = &H40000
Const SM_CXFULLSCREEN = 16
Const SM_CYFULLSCREEN = 17
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Dim hWndForm As Long
Dim IStyle As Long
Private Sub UserForm_Initialize()
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
IStyle = GetWindowLong(hWndForm, GWL_STYLE)
IStyle = IStyle Or WS_THICKFRAME
IStyle = IStyle Or WS_MINIMIZEBOX
IStyle = IStyle Or WS_MAXIMIZEBOX
SetWindowLong hWndForm, GWL_STYLE, IStyle
End Sub
Public Sub myShowMax()
SetActiveWindow hWndForm
ShowWindow hWndForm, SW_SHOWMAXIMIZED
End Sub

複製代碼

作者: bobomi 時間: 2015-5-15 17:49

我也第一次用ZOOM
發現它有缺陷, 寬高只能同放大或縮小, 不能一邊放大另一邊縮小
只好遷就它

// ================

Dim Form_First_wh
Dim Form_Last_wh

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
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const WS_THICKFRAME = &H40000
Const SM_CXFULLSCREEN = 16
Const SM_CYFULLSCREEN = 17
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Dim hWndForm As Long
Dim IStyle As Long

Private Sub UserForm_Initialize()
   hWndForm = FindWindow("ThunderDFrame", Me.Caption)
   IStyle = GetWindowLong(hWndForm, GWL_STYLE)
   IStyle = IStyle Or WS_THICKFRAME
   IStyle = IStyle Or WS_MINIMIZEBOX
   IStyle = IStyle Or WS_MAXIMIZEBOX

   SetWindowLong hWndForm, GWL_STYLE, IStyle

   Form_First_wh = Array(UserForm1.Width, UserForm1.Height)
   Form_Last_wh = Form_First_wh
End Sub

Public Sub myShowMax()
      SetActiveWindow hWndForm
      ShowWindow hWndForm, SW_SHOWMAXIMIZED
End Sub

Private Sub UserForm_Resize()
If (Form_First_wh(1) - UserForm1.Height) * (Form_First_wh(0) - UserForm1.Width) < 0 Then
   MsgBox "UserForm1.Zoom 無法支援視窗一邊放大, 另一邊卻縮小"
   UserForm1.Move UserForm1.Left, UserForm1.Top, Form_Last_wh(0), Form_Last_wh(1)
   Exit Sub
End If

On Error Resume Next
If Abs(Form_First_wh(1) - UserForm1.Height) > Abs(Form_First_wh(0) - UserForm1.Width) Then
   UserForm1.Width = UserForm1.Height / Form_First_wh(1) * Form_First_wh(0)
Else
UserForm1.Height = UserForm1.Width / Form_First_wh(0) * Form_First_wh(1)
End If
On Error GoTo 0

Form_Last_wh = Array(UserForm1.Width, UserForm1.Height)
UserForm1.Zoom = UserForm1.Height / Form_First_wh(1) * 100
End Sub

作者: PKKO 時間: 2015-5-17 09:37

回復 2# bobomi

大大好威~

感謝回復,經測試後21"螢幕可正常使用

反倒是筆電的13"螢幕會變成太大,有辦法依照比例自動放大或是縮小嗎?

作者: bobomi 時間: 2015-5-17 11:58

本帖最後由 bobomi 於 2015-5-17 12:04 編輯

我拿到13吋筆電試
比例好像ok耶
但是筆電有開視覺特效
才發現我的寫法會因為視覺特效一直刷新螢幕
導致 UserForm1 出現顫抖 ( 桌機沒開視覺特效 , 不會有這問題 )

所以你改成這樣看看
不去修改UserForm1 寬高, 使其自由度最大
但缺點你拉拉看就知道了
這問題出在 ZOOM 寬高只能同放大或縮小, 不能一邊放大另一邊縮小
不然 code 只要2行就解決了

(1)
Private Sub UserForm_Resize()
On Error Resume Next
UserForm1.Zoom = UserForm1.Height / Form_First_wh(1) * 100
End Sub
(2)
Private Sub UserForm_Resize()
On Error Resume Next
UserForm1.Zoom = UserForm1.Width / Form_First_wh(0) * 100
End Sub
(1) (2) 分別測試一下, 看看哪個比較適合

作者: bobomi 時間: 2015-5-17 12:09

如果還是不行
把 UserForm1 的程式碼刪光(只留控制項就可以了 )
然後匯出 UserForm1 -> 上傳 UserForm1.frm
我再拉拉看為何不行

作者: bobomi 時間: 2015-5-17 14:26

本帖最後由 bobomi 於 2015-5-17 14:30 編輯

改成下面的 code  (有發現問題在哪了)
看看筆電的13"螢幕問題是否改善
========================
Dim Form_First_wh
Dim Form_Last_wh
Dim UserForm1_BarHeight

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
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SetActiveWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Const GWL_STYLE = (-16)
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const WS_THICKFRAME = &H40000
Const SM_CXFULLSCREEN = 16
Const SM_CYFULLSCREEN = 17
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
Dim hWndForm As Long
Dim IStyle As Long

Private Sub UserForm_Initialize()
   hWndForm = FindWindow("ThunderDFrame", Me.Caption)
   IStyle = GetWindowLong(hWndForm, GWL_STYLE)
   IStyle = IStyle Or WS_THICKFRAME
   IStyle = IStyle Or WS_MINIMIZEBOX
   IStyle = IStyle Or WS_MAXIMIZEBOX

   SetWindowLong hWndForm, GWL_STYLE, IStyle


   a = UserForm1.Height
   UserForm1.Height = 0
   UserForm1_BarHeight = UserForm1.Height
   UserForm1.Height = a + 1.5

   Form_First_wh = Array(UserForm1.Width, UserForm1.Height)
   Form_Last_wh = Form_First_wh
End Sub

Public Sub myShowMax()
      SetActiveWindow hWndForm
      ShowWindow hWndForm, SW_SHOWMAXIMIZED
End Sub

Private Sub UserForm_Resize()
If Not IsArray(Form_First_wh) Then Exit Sub
' If (Form_First_wh(1) - UserForm1.Height) * (Form_First_wh(0) - UserForm1.Width) < 0 Then
'    MsgBox "UserForm1.Zoom 無法支援視窗一邊放大, 另一邊卻縮小"
'    UserForm1.Move UserForm1.Left, UserForm1.Top, Form_Last_wh(0), Form_Last_wh(1)
'    Exit Sub
' End If

On Error Resume Next
If Abs(Form_First_wh(1) - UserForm1.Height) > Abs(Form_First_wh(0) - UserForm1.Width) Then
   UserForm1.Width = (UserForm1.Height - UserForm1_BarHeight) / (Form_First_wh(1) - UserForm1_BarHeight) * Form_First_wh(0)
Else
UserForm1.Height = UserForm1.Width / Form_First_wh(0) * (Form_First_wh(1) - UserForm1_BarHeight) + UserForm1_BarHeight
'UserForm1.Height = UserForm1.Width / Form_First_wh(0) * Form_First_wh(1)
End If
On Error GoTo 0

Form_Last_wh = Array(UserForm1.Width, UserForm1.Height)
On Error Resume Next
UserForm1.Zoom = (UserForm1.Height - UserForm1_BarHeight) / (Form_First_wh(1) - UserForm1_BarHeight) * 100
End Sub

作者: bobomi 時間: 2015-5-17 14:29

還有一個方法, 就是不要用 ZOOM , 改成自己縮放

作者: bobomi 時間: 2015-5-17 16:01

Zoom 比較好的方案
[attach]20960[/attach]

作者: PKKO 時間: 2015-5-17 21:37

回復 8# bobomi

感謝大大的用心! 我測試完再跟您報告 !

作者: GBKEE 時間: 2015-5-18 10:01

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

回復 9# PKKO
試試看自己縮放.
這表單的程式碼

Option Explicit
Dim X As Double, Y As Double, e As Control
Private Sub UserForm_Initialize() '表單初始化的程式
Dim e As Control
X = Width
Y = Height
For Each e In Me.Controls
e.Tag = e.Top & "," & e.Left & "," & e.Width & "," & e.Height & "," & e.Font.Size
Next
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'發生在當使用者按了滑鼠鍵時。MouseDown 發生於使用者按下滑鼠鍵****
Dim xZoom As Double
If Shift = 2 Then 'Ctrl 鍵
Select Case Button '滑鼠
Case 1 '按下左滑鼠鍵。: 放大
xZoom = 1.2 '放大 %2
Case 2 '按下右滑鼠鍵。: 縮小
xZoom = 0.8 '所小 %2
End Select
Zoom_UserForm xZoom '表單縮放程式
ElseIf Shift = 1 Then 'Shift 鍵 +任一滑鼠按鍵
Revert_UserForm '表單還原原本大小
End If
End Sub
Private Sub Zoom_UserForm(xZoom As Double) '表單縮放
Width = Width * xZoom
Height = Height * xZoom
For Each e In Controls
With e
.Top = .Top * xZoom
.Left = .Left * xZoom
.Width = .Width * xZoom
.Height = .Height * xZoom
.Font.Size = .Font.Size * xZoom
End With
Next
End Sub
Private Sub Revert_UserForm() '表單還原原本大小
Dim xTag As Variant
Width = X
Height = Y
For Each e In Me.Controls
With e
xTag = Split(.Tag, ",")
.Top = xTag(0)
.Left = xTag(1)
.Width = xTag(2)
.Height = xTag(3)
.Font.Size = xTag(4)
End With
Next
End Sub

複製代碼

作者: GBKEE 時間: 2015-5-18 14:20

回復 10# GBKEE
表單最大化

Option Explicit
Private Sub UserForm_Initialize() '表單初始化的程式
Dim e As Control
For Each e In Me.Controls
e.Tag = e.Top & "," & e.Left & "," & e.Width & "," & e.Height & "," & e.Font.Size
Next
Form_xlMax
End Sub
Private Sub Form_xlMax() '表單最大化
Dim xlMax As Double, ylMax As Double, xZoom As Double
Dim e As Control
With Application
.WindowState = xlMaximized
xlMax = .Width
ylMax = .Height
End With
xZoom = 1
Do While Width < xlMax
Width = Width * xZoom
Height = Height * xZoom
For Each e In Controls
With e
.Top = .Top * xZoom
.Left = .Left * xZoom
.Width = .Width * xZoom
.Height = .Height * xZoom
.Font.Size = .Font.Size * xZoom
Debug.Print xZoom, .Font.Size
End With
Next
xZoom = xZoom * 1.0000654
Loop
Top = 0
Left = 0
End Sub

複製代碼

作者: PKKO 時間: 2015-5-19 18:59

本帖最後由 PKKO 於 2015-5-19 19:01 編輯

回復 8# bobomi

javascript:;
感謝大大,我測試過可以自動放大的userform 超酷的~跟網頁一樣自由奔放,但....放大效果不佳,以您的userfrom來放大之後會發現比例怪怪的
我想原因應該是跟妳說的一樣,zoom只能同時放大,無法只調整任何一邊的關係

至於13"電腦的部分,我測試過妳最後的程式碼,跟之前的一樣呢!會超出邊界(本身原本的大小是不會超過的)

附件是我的USERFORM的大小!

作者: PKKO 時間: 2015-5-19 19:00

回復 11# GBKEE

超版大大,我放入表單內使用,並取代USERFORM的所有程式碼,但無論怎麼點滑鼠都無法反映?

作者: GBKEE 時間: 2015-5-19 19:45

回復 13# PKKO

10# 的程式碼
放大: 鍵盤Ctrl 鍵 + 按下左滑鼠鍵
縮小: 鍵盤Ctrl 鍵 + 按下右滑鼠鍵
還原: 鍵盤Shift鍵 +按下滑鼠任一鍵

If Shift = 2 Then 'Ctrl 鍵
Select Case Button '滑鼠
Case 1 '按下左滑鼠鍵。: 放大
xZoom = 1.2 '放大 %2
Case 2 '按下右滑鼠鍵。: 縮小
xZoom = 0.8 '縮小 %2
End Select
Zoom_UserForm xZoom '表單縮放程式
ElseIf Shift = 1 Then 'Shift 鍵 +任一滑鼠按鍵
Revert_UserForm '表單還原原本大小
End If

複製代碼

11#的程式碼
表單開啟自動最大化

作者: PKKO 時間: 2015-5-19 20:42

回復 14# GBKEE

感謝,已了解使用方式!

作者: bobomi 時間: 2015-5-19 22:40

[attach]20983[/attach]

作者: PKKO 時間: 2015-5-20 08:25

回復 16# bobomi

大大,裡面沒有userform = =

作者: PKKO 時間: 2015-5-20 09:29

回復 8# bobomi

大大您好,
按照大大您的做法,可以手動拉大比率(大大您已經完成了!),但可否加上一個自動儲存Userform最後的調整狀況,如果沒有記憶,使用者每次都要調整實在辛苦(例如記憶在FormSize這個sheet名稱內),
下次打開始會自動抓取上次調整的大小!

作者: PKKO 時間: 2015-5-20 09:36

回復 10# GBKEE

超版大大您好,您的這個方式可以保持表單以及內容比率的完整性,非常實用,也可讓小弟了解到底是如何放大及縮小的
但有沒有辦法可以直接放大
而且放大的比率是以寬或是高,任一邊的極限為極限
避免高已經到極限了,可是寬還沒,導致直接放到最大化之後,高會超過螢幕可視的位置

作者: bobomi 時間: 2015-5-20 12:59

[attach]20990[/attach]
最大化時, 控件不會過大

作者: GBKEE 時間: 2015-5-20 13:56

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

回復 19# PKKO
直接放大

Option Explicit
Dim Form_Tag As Variant
Private Sub UserForm_Initialize() '表單初始化的程式
Dim e As Control
Form_Tag = Split(Top & "," & Left & "," & Width & "," & Height & "," & Font.Size, ",")
Form_xlMax
End Sub
Private Sub Form_xlMax() '表單最大化
Dim xZoom As Double, yZoom As Double, e As Control
With Application
.WindowState = xlMaximized
xZoom = .Width / Form_Tag(2) '寬放大的比例
yZoom = .Height / Form_Tag(3) '高放大的比例
End With
Top = 0
Left = 0
Width = Width * xZoom
Height = Height * yZoom
For Each e In Controls
With e
.Top = .Top * xZoom
.Left = .Left * xZoom
.Width = .Width * xZoom
.Height = .Height * yZoom
.Font.Size = .Font.Size * xZoom
End With
Next
End Sub

複製代碼

作者: PKKO 時間: 2015-5-20 21:00

回復 20# bobomi

比例上還是會有點奇怪,放到最大時,右邊會有多餘的空間,不過沒關係,已經很感謝妳囉!

作者: PKKO 時間: 2015-5-20 21:51

回復 21# GBKEE

感謝超版大大,這個超好用的了(而且程式碼很簡短)
只是表單偵測的高度部分,他會偵測整個螢幕的高度
無法只偵測到工作列的高度就好

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

作者: bobomi 時間: 2015-5-20 21:56

回復 23# PKKO

zoom 就只能這樣 (它的寬高都只能是相同比例)
要想下邊的控件不會過頭, 那麼右邊就會有多餘的空間
要想右邊沒有多餘的空間 , 那麼下邊的控件就會過頭

自己縮放沒有上面問題 ( 但是字型無法完美縮放  )
終極一點  自己縮放 + Zoom 混搭 -> 字型可以較完美縮放

作者: bobomi 時間: 2015-5-21 21:18

[attach]21008[/attach]
這樣還會蓋到嗎?

作者: GBKEE 時間: 2015-5-22 06:28

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

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

這樣可以嗎?

Option Explicit
Dim Form_Tag As Variant
Private Sub UserForm_Activate()
Form_xlMax
End Sub
Private Sub Form_xlMax() '表單最大化
Dim xZoom As Double, yZoom As Double, e As Control
With Application
.WindowState = xlMaximized
xZoom = .Width / Me.Width '寬放大的比例
'****************
yZoom = .Height / (Me.Height + 20) '高放大的比例
'****************
End With
Top = 0
Left = 0
Width = Width * xZoom
Height = Height * yZoom
For Each e In Controls
With e
.Top = .Top * xZoom
.Left = .Left * xZoom
.Width = .Width * xZoom
.Height = .Height * yZoom
.Font.Size = .Font.Size * yZoom
End With
Next
End Sub

複製代碼

作者: bobomi 時間: 2015-5-22 07:24

這樣還會蓋到嗎?
bobomi 發表於 2015-5-21 21:18

奇怪咧!! 我匯出的檔案為何不是沒更新, 不然就是沒有 UseForm
重新上傳

[attach]21013[/attach]

作者: stillfish00 時間: 2015-5-22 14:13

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

[attach]21017[/attach]

作者: PKKO 時間: 2015-5-22 21:32

回復 26# GBKEE

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

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

作者: PKKO 時間: 2015-5-22 22:05

本帖最後由 PKKO 於 2015-5-22 22:08 編輯

回復 27# bobomi

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

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

ocx.Left = ocx_xy(0) * Rw
ocx.Top = ocx_xy(1) * Rh
ocx.Width = ocx_xy(2) * Rw
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 快速使用程式碼

Function LIST顯示(UserForm, LISTBOX, RNG)
checkUpdate = True
'將資料顯示在LISTBOX 上
LISTBOX.ColumnCount = UBound(RNG, 2)
LISTBOX.List = RNG 'ListBox 的顯示方式
'自動調整的程式
'新增以下code
Dim sWidth As String, dTotal As Double
Dim oTemp As Object
Set oTemp = UserForm.Controls.Add("Forms.TextBox.1")
With oTemp
.AutoSize = True'在這行程式碼的地方會啟動Private Sub UserForm_Layout()導致錯誤
.MultiLine = True
.WordWrap = False
.SelectionMargin = False
.Font.Name = LISTBOX.Font.Name
.Font.Size = LISTBOX.Font.Size
End With
For j = 0 To LISTBOX.ColumnCount - 1
oTemp.Text = ""
For i = 0 To LISTBOX.ListCount - 1
oTemp.Text = oTemp.Text & LISTBOX.List(i, j) & vbCr
Next
dTotal = dTotal + oTemp.Width
sWidth = sWidth & oTemp.Width + 10 & ";"
Next
UserForm.Controls.Remove oTemp.Name
LISTBOX.ColumnWidths = sWidth
End Function

複製代碼

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

作者: PKKO 時間: 2015-5-23 11:29

回復 27# bobomi

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

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

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

複製代碼

錯誤發生在上方的height那邊

作者: bobomi 時間: 2015-5-23 19:46

本帖最後由 bobomi 於 2015-5-23 19:51 編輯

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

[attach]21024[/attach]

作者: PKKO 時間: 2015-5-24 09:33

回復 32# bobomi

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

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

Private Sub UserForm_Activate()
modForm.UserForm_SetButton Me
End Sub

複製代碼

作者: bobomi 時間: 2015-5-24 22:10

[attach]21025[/attach]

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

這個暫時解決不了

作者: s13030029 時間: 2019-7-26 10:55

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

詳細內容在這裡

作者: lichang 時間: 2021-6-2 14:12

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

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