UserForm Tam ekran yapma

[asdsxx]

Arkadaşlar UserForm açılışda kod ile hangi ekran büyüklüğünde açılırsa açılsın tam ekran modunda açılıyordu. Ancak 16" , 3200x2000 ekran çöxünürlüğü olan bir laptopta tam ekran kodu tam işe yaramadı ve UserForm ekranın dışına taştı. Bunun çözümü var mı acaba?
Kod aşağıda bu kodun daha önceki tüm ekran büyüklüklerinde çalışdığı gibi yukarıdaki ekran çözünürlüğünde de çalışması için nasıl bir değişiklik yapılması gerekir.
mevcut kod aşağıda...

Private Sub UserForm_Activate()

 'UserForm tam ekran yapma programı

 Dim hWndForm As Long, frmStyle As Long
    hWndForm = FindWindow(vbNullString, Me.Caption)
    frmStyle = GetWindowLong(hWndForm, (-16))
    frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
    SetWindowLong hWndForm, (-16), frmStyle
    ShowWindow hWndForm, 3
    DrawMenuBar hWndForm
    
    Me.Zoom = Round((Me.Height / ilkyukseklik) * 100, 0)
End Sub

 

[mustafa1205]

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub UserForm_Activate()
Dim EkranGenislik As Long, EkranYukseklik As Long
Dim OranX As Double, OranY As Double

'Ekran çözünürlüğünü al
EkranGenislik = GetSystemMetrics(SM_CXSCREEN)
EkranYukseklik = GetSystemMetrics(SM_CYSCREEN)

'UserForm'u tam ekran boyutuna ölçekle
With Me
.StartUpPosition = 0
.Left = 0
.Top = 0

'Ekran çözünürlüğüne göre form boyutunu ayarla
.Width = EkranGenislik * 0.75
.Height = EkranYukseklik * 0.75

'Oranları ayarla (isteğe bağlı)
OranX = (EkranGenislik / 1920) 'örnek referans: 1920x1080
OranY = (EkranYukseklik / 1080)
.Zoom = Round(Application.Min(OranX, OranY) * 100, 0)
End With
End Sub




Dener misiniz ?

 

[asdsxx]

Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub UserForm_Activate()
Dim EkranGenislik As Long, EkranYukseklik As Long
Dim OranX As Double, OranY As Double

'Ekran çözünürlüğünü al
EkranGenislik = GetSystemMetrics(SM_CXSCREEN)
EkranYukseklik = GetSystemMetrics(SM_CYSCREEN)

'UserForm'u tam ekran boyutuna ölçekle
With Me
.StartUpPosition = 0
.Left = 0
.Top = 0

'Ekran çözünürlüğüne göre form boyutunu ayarla
.Width = EkranGenislik * 0.75
.Height = EkranYukseklik * 0.75

'Oranları ayarla (isteğe bağlı)
OranX = (EkranGenislik / 1920) 'örnek referans: 1920x1080
OranY = (EkranYukseklik / 1080)
.Zoom = Round(Application.Min(OranX, OranY) * 100, 0)
End With
End Sub




Dener misiniz ?

İlginize teşekkür ederim. Fakat çalışmadı. Hatta daha fazla kesti yani daha az kısmını gösterdi.
Daha önce farklı ekranlarda açınca bir kod düzenlemesi yapmadan kendi otomatik olarak ekran genişliğini "Full Ekran" olacak şekilde ayarlıyordu. yine aynı olmasını istiyorum.
Ayrıca Ekran 3200x200 olacak. sizin yazdığınız 1920x1080 de sıkıntı yoktu. İlk defa bu kadar geniş ekranda denedim, sıkıntı yarattı.

 

[Korhan Ayhan]

Belki işinize yarayabilir...

Option Explicit

Private Sub UserForm_Activate()
    With Application
        .WindowState = xlMaximized
        Zoom = Int(.Width / Me.Width * 100)
        Me.StartUpPosition = 0
        Me.Top = .Top
        Me.Left = .Left
        Me.Height = .Height
        Me.Width = .Width
    End With
End Sub