3 Monitörde Userform Pozisyonu Hakkında

[petsiye]

Merhaba,

Excel dosyamda onlarca farklı Userform bulunmakta. Çoğunun Initialize kodu aşağıdaki gibidir. Benim sorunum, dosyayı 2 veya 3 monitör ile kullanan kullanıcılar, Excel dosyasının tablo kısmının bir monitörde, Userformun ise başka bir monitörde açıldığını belirtiyor. Excel dosyası hangi monitörde aktifse, Userformların da yine aynı monitörde açılmasını sağlamak istiyorum. ( Userformları taşımasını engellediğim için manuel taşıyamıyorlar. Taşımayı aktif hale getirdiğimde Userform görsel olarak ekranı ortamayabiliyor dolayısıyla bunu aktif hale getirmek istemiyorum )

Bu konuda bana yardımcı olabilecek üstadlara şimdiden çok teşekkür ederim.

Saygılarımla


Private Sub UserForm_Initialize()


Me.StartUpPosition = 0
Me.Left = Application.Left + 0
Me.Top = Application.Top + 0

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 = Application.Width
Y1 = Application.Height
X2 = Me.Width
Y2 = Me.Height
CX = X1 / X2
CY = Y1 / Y2
Me.Width = X1
Me.Height = Y1
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
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub

 

[yanginci34]

Kodu denermisiniz

#If VBA7 Then
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Sub UserFormuAktifMonitordeAc()
    Dim hWnd As LongPtr
    Dim r As RECT
    Dim xlAppName As String
    
    ' Excel penceresinin handle'ını al
    xlAppName = Application.Caption
    hWnd = FindWindow("XLMAIN", vbNullString)
    
    ' Pencerenin konumunu al
    If hWnd <> 0 Then
        GetWindowRect hWnd, r
    End If
    
    ' UserForm'u Excel penceresiyle aynı monitörde aç
    With UserForm1
        .StartUpPosition = 0 ' Manuel konum belirleme
        .Left = r.Left + 50 ' Excel'in sol konumuna göre ayarla
        .Top = r.Top + 50   ' Excel'in üst konumuna göre ayarla
        .Show
    End With
End Sub

 

[petsiye]

Bu kodu her bir Userform içerisine mi yapıştırmam gerekiyor acaba ?

 

[yanginci34]

Bu kodu her bir Userform içerisine mi yapıştırmam gerekiyor acaba ?

evet ayrıca; aşağıdaki kodun içindeki ismi kendi userform isminize göre uyarlayın sizin
With UserForm1
.StartUpPosition = 0 ' Manuel konum belirleme
.Left = r.Left + 50 ' Excel'in sol konumuna göre ayarla
.Top = r.Top + 50 ' Excel'in üst konumuna göre ayarla
.Show
End With