Tôi nghĩ thế này:
Điều chỉnh kích cở form bằng tay (Kéo ra rồi kéo vào) tương ứng vị trí và kích cở các control sẽ thay theo đến 1 mức nhất định nào đó được không anh?
Tôi nghĩ cái này có liên quan đến độ phân giải màn hình
With Me
.Width = Application.Width
.Height = Application.Height
End WithMrate1 = Application.Width / 1024
Msize = Me.Width
Mrate2 = Msize / 600Me.Width = 600 * Mrate1
Me.Height = 450 * Mrate1With Me.Cmbb1
.Top = 54 * mrate2
.Left = 18 * mrate2
.Height = 18 * mrate2
.Width = 140 * mrate2
.Font.Size = 8 * mrate2
End WithPrivate Declare Function GetDesktopWindow Lib "User32" () As Long
Private Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
Private Declare Function ChangeDisplaySettings Lib "User32" Alias _
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "User32" Alias _
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As BooleanConst DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CCFORMNAME = 32
Const CCDEVICENAME = 32Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End TypeType RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End TypeFunction Change_SR(iWidth As Single, iHeight As Single)
Dim DevM As DEVMODE, EDS As Boolean, i As Long
Do
EDS = EnumDisplaySettings(0&, i&, DevM)
i = i + 1
Loop Until EDS = False
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmPelsWidth = iWidth
DevM.dmPelsHeight = iHeight
ChangeDisplaySettings DevM, 0
End FunctionFunction Get_SR() As String
Dim R As RECT
Application.Volatile
GetWindowRect GetDesktopWindow(), R
Get_SR = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
End FunctionSub ChangeScreenResolution()
Dim NewSR
On Error GoTo ExitSub
NewSR = LCase(Application.InputBox("Go do phan giai vao day" & vbLf & _
"Vi du: 1025X768", Type:=2))
Change_SR CLng(Split(NewSR, "x")(0)), CLng(Split(NewSR, "x")(1))
ExitSub:
End SubNhư em đã nói, code em đưa ở trên vẫn có khả năng trả mọi thứ về như cũ ---> Vậy thì cho dù sư phụ có chạy đồng thời nhiều ứng dụng, trong đó có 1 vài ứng dụng bắt buộc phải có độ phân giải khác thì... cũng chẳng hề gì (Wb Deactive ta sẽ trả về nguyên gốc)
Ah... còn 1 rắc rối nữa sư phụ à: Lúc Zoom form có 1 vài control bị che khuất, đúng ra là nó trôi tuốt xuống dưới cùng nên chẳng tải nào dùng được (cụ thể trong file sư phụ là cái CommnadButton)
Em cũng dùng code trên để chỉnh độ phân giải màn hình cho ứng dụng của em cả ở VB và Access nhưng vấn đề đang gặp của em mà chưa tìm ra cách đó là trước khi chạy phải kiểm tra độ phân giải màn hình, lưu độ phân giải màn hình đó vào 1 biến, khi thoát khỏi chương trình thì Reset nó lại....
Private Sub UserForm_Activate()
CtrlResize
End SubCode tôi đưa ở trên có hàm kiểm tra độ phân giải hiện hành mà bạn (hàm Get_SR)---> Trước khi chạy code, dùng nó mà kiểm tra rồi lưu giá trị vào đâu đóEm cũng dùng code trên để chỉnh độ phân giải màn hình cho ứng dụng của em cả ở VB và Access nhưng vấn đề đang gặp của em mà chưa tìm ra cách đó là trước khi chạy phải kiểm tra độ phân giải màn hình, lưu độ phân giải màn hình đó vào 1 biến, khi thoát khỏi chương trình thì Reset nó lại....
Bởi vậy mới nói là nó còn tùy thuộc vào màn hình người dùng đang chạy nữa ---> Màn hình sư phụ không bị nhưng màn hình em đang dùng thì lại có vấn đề (màn hình em đang dùng thuộc dạng màn hình rộng, độ phân giải hiện hành = 1280 x 800)
ScreenWidth = GetSystemMetrics32(XScreen)
Mrate1 = ScreenWidth / 1024
ScreenHeight = GetSystemMetrics32(YScreen)
Mrate4 = ScreenHeight / 768
Fm1.Width = 600 * Mrate1
Fm1.Height = 450 * Mrate4Em cũng thấy nó như vậy. Qua sử dụng em thấy điều chỉnh độ phân giải màn hình cũng có nhược điểm, do không tương thích, và có những máy độ phân giải giống như của Thầy 1280*800 khi chỉnh về 800*600 thì nó không bun ra hết màn hình mà nó co nhỏ 1 chút xíu.....
Tôi đang nghĩ đến 1 dạng rút gọn code bằng vòng lặp duyệt qua từng control, nhưng còn đang bí chỗ này: Làm cách nào để biết Form đang ở trạng thái maximize?
Sub CtrlResize2()
With Fm1
Msize = .Width
Mrate2 = Msize / 600
FormState = "bí chỗ này"
For Each Ctl In .Controls
With Ctl
On Error Resume Next
.Top = .Top * IIf( FormState = True, 1 / Mrate2, Mrate2)
.Left = .Left * IIf(FormState = True, 1 / Mrate2, Mrate2)
.Height = .Height * IIf(FormState = True, 1 / Mrate2, Mrate2)
.Width = .Width * IIf(FormState = True, 1 / Mrate2, Mrate2)
.Font.Size = .Font.Size * IIf(FormState = True, 1 / Mrate2, Mrate2)
End With
Next
End With
End Sub
Sư phụ ơi, nếu minhthien đã phát hiện ra code zoom như ở trên thì em nghĩ không cần vòng lập nào ---> Đã kiểm tra, khi form zoom là toàn bộ control trên form cũng tự động chỉnh kích thước tương ứng ---> Quá khỏe!
Private Sub UserForm_Initialize()
Call MinMax(UserForm1.Caption)
H1 = UserForm1.Height
UserForm1.Height = 0 ' chỗ này cho bằng không để làm gì?'
H2 = UserForm1.Height ' tại sao không gán bằng không phứt?'
UserForm1.Height = H1 ' cho bằng không rồi quay lại bằng giá trị cũ?'
End SubPrivate Sub UserForm_Resize()
If Me.Height <= H2 Then
Application.WindowState = xlMinimized
Else
Application.Windows(ThisWorkbook.Name).WindowState = xlMaximized ' xlNormal'
End If
End SubỦa ---> Sư phụ nói đến code nào vậy? File tại bài 23 có code thế này cơ mà:
Private Sub UserForm_Initialize()
SpinButton1.Min = 10
SpinButton1.Max = 400
SpinButton1.Value = 100
Label1.Caption = SpinButton1.Value
CommandButton1.Caption = "Zoom it!"
End SubPrivate Sub UserForm_Zoom(Percent As Integer)
Dim MyResult As Double
If Percent > 99 Then
ScrollBars = fmScrollBarsBoth
ScrollLeft = 0
ScrollTop = 0
MyResult = Width * Percent / 100
ScrollWidth = MyResult
MyResult = Height * Percent / 100
ScrollHeight = MyResult
Else
ScrollBars = fmScrollBarsNone
ScrollLeft = 0
ScrollTop = 0
End If
End SubIf Val(Application.Version) < 9 Then
hWndForm = FindWindow("ThunderXFrame", sCaption) 'XL97
Else
hWndForm = FindWindow("ThunderDFrame", sCaption) 'XL2000
End IfTại sao để 2 dòng lệnh vào, cái form bé tí xíu vậy Anh?
Private Sub UserForm_Initialize()
Call MinMax(UserForm1.Caption)
End SubPrivate Sub UserForm_Initialize()
Call MinMax(UserForm1.Caption)
H1 = UserForm1.Height
UserForm1.Height = 0
H2 = UserForm1.Height
UserForm1.Height = H1
End Sub
Private Sub UserForm_Resize()
If Me.Height <= H2 Then
Application.WindowState = xlMinimized
Else
Application.Windows(ThisWorkbook.Name).WindowState = xlMinimized 'xlMaximized 'xlNormal
End If
End SubH1 = UserForm1.Height
UserForm1.Height = 0
H2 = UserForm1.Height
UserForm1.Height = H1
Bạn nên khai báo biến cho H1 và H2 là được, không phải vô lý mà người viết code lại viết như vậy đâu.
Bác ghé nơi này xem có phải thứ cần tìm không
Public Sub zoom(frm As Form)
ResWidth = Screen.Width / Screen.TwipsPerPixelX
ResHeight = Screen.Height / Screen.TwipsPerPixelY
ScreenRes = ResWidth & "x" & ResHeight
zoomn = ResWidth / 1024 ''(1024 x 768 là do phân giai màn hình khi thiet ke)
zoomd = ResHeight / 768
Dim MYCONTROL As Control
For Each MYCONTROL In frm.Controls
If Not TypeOf MYCONTROL Is Line Then
MYCONTROL.Left = MYCONTROL.Left * zoomn
If Not TypeOf MYCONTROL Is ComboBox Then
MYCONTROL.Height = MYCONTROL.Height * zoomd
End If
MYCONTROL.Top = MYCONTROL.Top * zoomd
MYCONTROL.Width = MYCONTROL.Width * zoomn
MYCONTROL.Font.Size = MYCONTROL.Font.Size * zoomn
Else
MYCONTROL.X1 = MYCONTROL.X1 * zoomn
MYCONTROL.Y1 = MYCONTROL.Y1 * zoomn
MYCONTROL.X2 = MYCONTROL.X2 * zoomn
MYCONTROL.Y2 = MYCONTROL.Y2 * zoomn
End If
Next
frm.Width = frm.Width * zoomn
frm.Height = frm.Height * zoomd
End Sub
Private Sub Form_Load()
Call zoom(UserForm1)
End SubCũng không dễ ăn đâu, vì trong VBA làm gì có Screen.Height, Screen.Width
Anh chỉ e cách thêm hai nút max và min cho file AnchorControls.xls với.
http://www.giaiphapexcel.com/forum/showthread.php?52745-Zoom-Userform-Controls&p=333826#post333826
Kakakaa, bạn không bị như thế mới là lạ đó, tỷ lệ form với tỷ lệ màn hình nó không tương thích nên khi nó zoom lên sẽ có một số nó chạy tuốt luốt xuống dưới chứ sao! Nhất là Frame và ListBox càng bị! Muốn được show toàn màn hình những control đó phải có code điều chỉnh và cân đối, canh giữa nữa chứ! Muốn thủ tục điều chỉnh không? Đóng học phí 1 tháng nhé! Kakakaka.
Trước tiên bạn làm 1 form với Size 400x600 (tạm gọi là size chuẩn hen) rồi tất cả các control bạn sắp xếp sao cho cân đối toàn bộ trên đó. (mé mé cho tức chơi nè kakaka)
Cái này có lý
ĩ''Thuat toan nam tai day!
Dim i As Long
For i = 1 To 4
With Me("CommandButton" & i)
.Top = Me.InsideHeight - .Height - 12
End With
Next
Frame1.Height = CommandButton1.Top - Frame1.Top - 12
ListBox1.Height = CommandButton1.Top - ListBox1.Top - 12
End SubVới cái file này, khi bạn bấm nút Normal, bạn có thể nắm mép (cạnh) của Form (sẽ có mũi tên 2 chiều) các bạn co giản độ rộng, cao của form, các bạn sẽ thấy, các Control của form đều canh rất cân đối theo tỷ lệ của form lớn nhỏ tùy ý.Số mình dại gái toàn tập rồi, kể cả gái pê-đê!
Thôi mời các "gái gú" xem file luôn đi ợ!
20 bài, lạc đề, và tôi xóa
Thật ra các bạn mà để ý sẽ thấy tôi cân đối tất cả các controls trên form theo bài này rồi:
Vậy bạn đưa file lên là nút gì vậy? Sao toàn CommandButton không à! Vị trí có dúng như thế không? Số lượng thực tế thế nào để điều chỉnh chứ không lại đưa file lên mà hỏi nữa! Đưa Form thực tế đi bạn.
Vậy sao bạn nói: Cmd_Them,Cmd_Sua, Cmd_Xoa, Cmd_Thoat ?
Nếu chỉ bố trí như thế thì, như tôi đã nói, tạo cái form chuẩn 402x600 rồi sắp xếp toàn bộ control lên đó sao cho hợp lý nhất, vậy thì cái cần điều chỉnh chỉ có mỗi cái ListBox2, còn mấy thứ khác không thay đổi.
''Thuat toan nam tai day!
With ListBox2
.Height = Me.InsideHeight - .Top [COLOR=#ff0000][B]- 6[/B][/COLOR]
End WithÔi trời ơi, cơ bản nó cũng giống với ListBox thôi, sao bạn không tự phân tích và làm? Khi bạn có khái niệm thực hiện thì với mọi Form bạn có thể điều khiển được.
''Thuat toan nam tai day!
With MultiPage1
.Height = Me.InsideHeight - .Top - 6
End WithQuất đại vầy đi, xem có được hông?
''Thuat toan nam tai day!
Dim i As Byte
MultiPage1.Height = Me.InsideHeight - MultiPage1.Top - 6
With CommandButton1
.Top = MultiPage1.Height - 2 * .Height
For i = 2 To 6
Me("CommandButton" & i).Top = .Top
Next
ListBox1.Height = .Top - ListBox1.Top - 6
ListBox2.Height = .Top - ListBox2.Top - 6
End With ''Thuat toan nam tai day!
MultiPage1.Height = Me.InsideHeight - MultiPage1.Top - 6
[COLOR=#ff0000][B] DoEvents[/B][/COLOR]
Dim i As Byte
With CommandButton1
.Top = [COLOR=#0000ff]MultiPage1.Pages([/COLOR][COLOR=#ffa07a]MultiPage1.SelectedItem.Index[/COLOR][COLOR=#0000ff]).InsideHeight[/COLOR] - .Height - 6
For i = 2 To 6
Me("CommandButton" & i).Top = .Top
Next
ListBox1.Height = .Top - ListBox1.Top - 6
ListBox2.Height = .Top - ListBox2.Top - 6
End WithMong Anh Nghĩa làm giúp em bài #74 với!!!!!
[B][COLOR=#0000ff] '''Thuật toán nằm tại đây![/COLOR][/B]
[COLOR=#0000ff] '''Tính chiều cao và chiều rộng của MultiPage1 sao cho fit với UserForm:[/COLOR]
MultiPage1.Width = Me.InsideWidth
MultiPage1.Height = Me.InsideHeight
[COLOR=#0000ff] '''Chạy tiếp sự kiện để cập nhật chiều cao bên trong (chiều cao "lọt lòng") của MultiPage1:[/COLOR]
DoEvents
[COLOR=#0000ff] '''Tính chiều cao bên trong của MultiPage1:[/COLOR]
Dim MtpInsideHeight As Single
MtpInsideHeight = MultiPage1.Pages(MultiPage1.SelectedItem.Index).InsideHeight
[COLOR=#0000ff] '''Căn cứ vào MtpInsideHeight tính chiều cao của các ListBox (đặc điểm chung là đáy của chúng sát đáy của [/COLOR][COLOR=#0000FF]MultiPage1, nên chúng được tính giống nhau)[/COLOR][COLOR=#0000ff]:[/COLOR]
ListBox1.Height = MtpInsideHeight - ListBox1.Top - 6
ListBox2.Height = MtpInsideHeight - ListBox2.Top - 6
ListBox3.Height = MtpInsideHeight - ListBox3.Top - 6
ListBox5.Height = MtpInsideHeight - ListBox5.Top - 6
ListBox6.Height = MtpInsideHeight - ListBox6.Top - 6
ListBox7.Height = MtpInsideHeight - ListBox7.Top - 6
[COLOR=#008000][B] '''TÍNH CÁC CONTROL TRONG PAGE4:
[/B][/COLOR] [COLOR=#ff0000] '''Cứ cái gì sát đáy của [/COLOR][COLOR=#ff0000]MultiPage1 [/COLOR][COLOR=#ff0000]thì tính trước, dần dần tính tiếp lên trên:[/COLOR]
[COLOR=#0000ff] '''Căn cứ vào MtpInsideHeight tính chiều cao của CmdSua:[/COLOR]
CmdSua.Top = MtpInsideHeight - CmdSua.Height - 6
With tb1
[COLOR=#0000ff] '''Căn cứ vào MtpInsideHeight tính chiều cao của TextBox tb1:[/COLOR]
.Top = MtpInsideHeight - .Height - 6
[COLOR=#0000ff] '''Vì Top của các TextBox còn lại đều bằng Top[/COLOR]
[COLOR=#0000ff] '''của tb1 [/COLOR][COLOR=#0000FF]nên phải quy chúng có Top bằng nhau[/COLOR][COLOR=#0000ff]:[/COLOR]
tb2.Top = .Top
tb3.Top = .Top
With lblTb1
[COLOR=#0000ff] '''Căn cứ vào Top của tb1, tính Top của các Label,[/COLOR]
[COLOR=#0000ff] '''chỉ cần dịch chuyển chiều cao Label lên phía trên[/COLOR]
[COLOR=#0000ff] '''so với TextBox tb1 là được:[/COLOR]
.Top = tb1.Top - .Height
[COLOR=#0000ff] '''Vì Top của các Label còn lại đều bằng Top[/COLOR]
[COLOR=#0000ff] '''của Label lblTb1 [/COLOR][COLOR=#0000FF]nên phải quy chúng có Top bằng nhau[/COLOR][COLOR=#0000ff]:[/COLOR]
lblTb2.Top = .Top
lblTb3.Top = .Top
[COLOR=#0000ff] '''Căn cứ vào Top của Label lblTb1 tính chiều cao của ListBox4:[/COLOR]
ListBox4.Height = .Top - ListBox4.Top - 2
End With
End WithTặng bạn thêm 1 thủ thuật ở Page1 nè, bạn tự tìm hiểu và tự chế thêm với các Page còn lại nếu bạn muốn chúng giống với Page1 nhé!Mong Anh Nghĩa làm giúp em bài #74 với!!!!!
''Thuat toan nam tai day!
MultiPage1.Width = Me.InsideWidth
MultiPage1.Height = Me.InsideHeight
DoEvents
Dim MtpInsideHeight As Single
MtpInsideHeight = MultiPage1.Pages(MultiPage1.SelectedItem.Index).InsideHeight
ListBox3.Height = MtpInsideHeight - ListBox3.Top - 6
ListBox4.Height = MtpInsideHeight - ListBox4.Top - 6
ListBox5.Height = MtpInsideHeight - ListBox5.Top - 6
''xet page1
With CmdGhi1
.Top = MtpInsideHeight - .Height - 6
CommandButton1.Top = .Top
CommandButton2.Top = .Top
ListBox1.Height = .Top - ListBox1.Top - 2
End With
''xet page2
With CmdGhi2
.Top = MtpInsideHeight = .Height - 6
CommandButton4.Top = .Top
CommandButton5.Top = .Top
ListBox2.Height = .Top - ListBox2.Top - 2 [B][COLOR=#ff0000]<----lỗi vàng chổ này.[/COLOR][/B]
End With
End Sub
With CmdGhi2
.Top = MtpInsideHeight [COLOR=#ff0000][SIZE=6][B]=[/B][/SIZE][/COLOR] .Height - 6Một cách để đảm bảo chiều cao của ListBox là bạn chọn trong thuộc tính của nó có mục IntergralHeight, hiện tại nó là True, nhưng nếu bạn đổi là False thì không bị thay đổi chiều cao của nó nữa.
