ekran boyutu ayarı

[sinemomec]

userform farklı bilgisayarlara açıldığında otomatik olarak boyutunu büyültme veya küçültme yapılabilirmi?

 

[YUSUF44]

Aşağıdaki konuyu incelemenizi tavsiye ederim:

ekran çözünürlügü

Merhaba arkadaşlar, Ben userformu ekran çözünürlüğüne göre ayarlamak istiyorum, ve üzerindeki textbox, combobox, listbox ve commantbutton larda aynı oranda büyüsün küçülsün istemiştim, ama userform ekrana göre büyüyor digerleri formun sol üst köşesinde kalıyor, bunu nasıl yapabilirim yardımcı...

www.excel.web.tr

 

[sinemomec]

burayı inceledim buradaki kodu userformun modulune ekleyin ibaresi var ben de 4 tane userform var hepsine tek tek mi ekleceğim.

Private Declare Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long
'
Private Sub UserForm_Initialize()
Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = [B][COLOR=red]800[/COLOR][/B]
Y1 = [B][COLOR=red]600[/COLOR][/B]
X2 = GetSystemMetrics32(0)
Y2 = GetSystemMetrics32(1)
CX = X2 / X1
CY = Y2 / Y1
Me.Width = Me.Width * CX
Me.Height = Me.Height * CY
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub

 

[YUSUF44]

Muhtemelen öyle yapmalısınız. Çünkü kodlar "Me.Width" şeklinde, yani "Benim.Genişliğim".

 

[sinemomec]

peki Private Sub UserForm_Initialize eklemeliyim

 

[sinemomec]

Private Declare Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long
bı kısımda hata veriyor

 

[YUSUF44]

Bu kodlar zaten initialize kodu. Kod bölümü açılınca herhangi bir kod bloğunun içine değil boşluğa yapıştırın. Zaten initialize kodlarınız varsa

Private Sub UserForm_Initialize()

ile

End Sub

arasındaki satırları kendi kodlarınız arasına ekleyin.


Hatayı düzeltmek için Private ile Devlare arasına PtrSafe ifadesini ekleyin.

 

[sinemomec]

peki bu kod ile yukardaki kod arasındaki çalışma farkı nedir hangisi daha sağlıklı olur

Option Explicit
Type RECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type

#If VBA7 And Win64 Then
Declare PtrSafe Function GetDesktopWindow Lib "User32" () As Long
Declare PtrSafe Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#Else
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#End If

Function ekrancozunurlugu() As String
Dim R As RECT
Dim hWnd As Long
Dim RetVal As Long
hWnd = GetDesktopWindow()
RetVal = GetWindowRect(hWnd, R)
ekrancozunurlugu = (R.x2 - R.x1) & "x" & (R.y2 - R.y1)
If ekrancozunurlugu = "1920x1080" Then ActiveWindow.Zoom = 162
If ekrancozunurlugu = "1680x1050" Then ActiveWindow.Zoom = 141
If ekrancozunurlugu = "1600x1200" Then ActiveWindow.Zoom = 134
If ekrancozunurlugu = "1600x900" Then ActiveWindow.Zoom = 134
If ekrancozunurlugu = "1440x900" Then ActiveWindow.Zoom = 120
If ekrancozunurlugu = "1400x1050" Then ActiveWindow.Zoom = 116
If ekrancozunurlugu = "1366x768" Then ActiveWindow.Zoom = 113
If ekrancozunurlugu = "1360x768" Then ActiveWindow.Zoom = 113
If ekrancozunurlugu = "1280x1024" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1280x960" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1280x800" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1280x768" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1280x720" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1280x600" Then ActiveWindow.Zoom = 106
If ekrancozunurlugu = "1152x864" Then ActiveWindow.Zoom = 95
If ekrancozunurlugu = "1024x768" Then ActiveWindow.Zoom = 84
If ekrancozunurlugu = "800x600" Then ActiveWindow.Zoom = 65
End Function


#If VBA7 And Win64 Then
Declare PtrSafe Function GetDesktopWindow Lib "User32" () As Long
Declare PtrSafe Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#Else
Declare Function GetDesktopWindow Lib "User32" () As Long
Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, rectangle As RECT) As Long
#End If

 

[YUSUF44]

İlk kod ekran çözünürlüğüne göre tüm nesnelerin boyutunu değiştiriyor. İkinci kod ise boyutta herhangi bir değişiklik yapmıyor, sadece büyüteç olarak görünümü değiştiriyor.

 

[sinemomec]

ilk kod daha kullanışlı olmuş oluyor o zaman kullanmak daha mantıklı bir çalışma oluyor.

 

[sinemomec]

syntax error hayası aldım

Private Sub UserForm_Initialize()
listele

Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
Dim CX As Double, CY As Double
Dim MyCtrl As Control
X1 = [B][COLOR=red]800[/COLOR][/B]
Y1 = [B][COLOR=red]600[/COLOR][/B]
X2 = GetSystemMetrics32(0)
Y2 = GetSystemMetrics32(1)
CX = X2 / X1
CY = Y2 / Y1
Me.Width = Me.Width * CX
Me.Height = Me.Height * CY
For Each MyCtrl In Me.Controls
MyCtrl.Top = MyCtrl.Top * CY
MyCtrl.Left = MyCtrl.Left * CX
MyCtrl.Width = MyCtrl.Width * CX
MyCtrl.Height = MyCtrl.Height * CY
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub

 

[YUSUF44]

Köşeli parantez içindeki ifadeler forumda yazı biçimlendirme için kullanılıyorlar. Onları silin.

X1 = [B][COLOR=red]800[/COLOR][/B]
Y1 = [B][COLOR=red]600[/COLOR][/B]


yerine

X1 =800
Y1 =600

olmalı.

 

[sinemomec]

Private Declare Function GetSystemMetrics32 Lib "User32" Alias "GetSystemMetrics" _
(ByVal nIndex As Long) As Long
bu kısmı eklemedim yalnız acaba yanlış olur mu bide tüm userformlara ekliyorum

 

[YUSUF44]

Ben konuya hakim değilim. Sorularınızı o konuda sorarsanız ya da kodun yazarı Haluk üstadımızı etiketlerseniz daha iyi olur diye düşünüyorum.

 

[sinemomec]

tammdır çok teşekkür ederim.

 

[Korhan Ayhan]

Yusuf beyin 2. mesajımda önerdiği linkteki 13 nolu mesajda bulunan kodları deneyiniz.

 

[sinemomec]

evet oldu