User Form Tam Ekran ve Sabitleme Hakkında

[petsiye]

Merhaba,

Öncelikle ülkemizin yaşadığı olağanüstü deprem felaketinden etkilenen herkese büyük geçmiş olsun, ve bu büyük felakette hayatını kaybeden tüm vatandaşlarımıza da Allah'tan rahmet diliyorum.

Forumda konu ile ilgili başlıklardan edindiğim bazı kodlar var. Fakat hiçbiri istediğimi tam olarak karşılamıyor. İstediğim tam olarak, User Form'un Ekran ve çözünürlük farketmeksizin, her pc de ( laptop veya masaüstü ) tam ekran olarak açılarak, açıldıktan sonra ise sağa-sola-yukarı-aşağı taşınmasını engelleyecek bir kod arıyorum. Elimdeki farklı kodlar aşağıdaki gibidir. ( Kodlardaki parametleri değiştirerek her şekilde denedim fakat bir sonuç alamadım )

Yardımlarınız için şimdiden teşekkür ederim


Elimdeki 1. Kod ;

Private Sub UserForm9_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 = 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
On Error Resume Next
MyCtrl.Font.Size = MyCtrl.Font.Size * CY
On Error GoTo 0
Next
End Sub






Elimdeki 2. Kod ;

Private Sub UserForm9_Activate()
Me.Top = Application.Top
Me.Left = Application.Left
Me.Top = Application.Top + (Application.UsableHeight / 2)
Me.Left = Application.Left + (Application.UsableWidth / 2)
End Sub



Elimdeki 3. Kod ;

Private Sub UserForm_Layout()
Me.Top = (Application.Height - Me.Height) / 2
Me.Left = (Application.Width - Me.Width) / 2
End Sub



Elimdeki 4. Kod ;

Private Sub UserForm9_Layout()
Application.Windows(ThisWorkbook.Name).Visible = False
With Me
.Left = (GetDesktopMaximumWidth() / 2.5) - .Width / 2
.Top = (GetDesktopMaximumHeight() / 4) - .Width / 2
End With
End Sub

 

[dEdE]

Merhaba,
Yukarıda yazdığınız kodlar ile UserFormu tam ekran yapabilirsiniz.
"...sağa-sola-yukarı-aşağı taşınmasını engelleyecek bir kod arıyorum ...." Aşağıdaki kod ise istediğinizi yapar. Kod alıntıdır, nereden aldığımı not etmemişim.

Private Type Position
 Left As Single
 Top As Single
End Type

Private Sub UserForm_Layout()
    Static Pos As Position
    Dim Mvd As Boolean
    
    If Pos.Left = 0 Or Pos.Top = 0 Then
        Pos.Left = Me.Left
        Pos.Top = Me.Top
        Exit Sub
    End If
    
    Mvd = False
    If Me.Left <> Pos.Left Then
        Me.Left = Pos.Left
        Mvd = True
    End If
    If Me.Top <> Pos.Top Then
        Me.Top = Pos.Top
        Mvd = True
    End If
    
    If Mvd Then
        MsgBox "UserFormu taşımaya çalışmayınız", vbCritical
    End If
End Sub

 

[petsiye]

Merhaba,
Verdiğiniz kodu olduğu şekilde yapıştırdım fakat hata aldım.

 

[dEdE]

...Verdiğiniz kodu olduğu şekilde yapıştırdım fakat hata aldım.

Merhaba,
Kod ben de hata vermiyor.
Kodu UserFormun koduna yapıştırmalısınız.
Örnek dosya paylaşırsanız , yardımcı olmaya çalışırız.

 

[petsiye]

Dosyam oldukça büyük olduğu için gönderemedim fakat aldığım hata Ek'teki gibidir. Belittiğini şekilde Usrer Formun Kod bölümüne yapıştırdım.

 

[dEdE]

Merhaba,
#4 numaralı mesajıma örnek dosya ekledim. İnceler misiniz?

Ambiguous name detected

Office VBA reference topic

learn.microsoft.com

Ambiguous Name Detected VBA

This article will explain the reason that an ambiguous name is detected in VBA. There are a number of different reasons why this error can occur in VBA.

www.automateexcel.com

 

[petsiye]

Örneğe baktım. Evet çalışıyor. teşekkür ederim. Fakat bendeki tam ekran kodları ile birlikte çalışmıyor. Hatayı o sebepten dolayı alıyorum

 

[dEdE]

Merhaba,
#4 numaralı mesajıma ekli örnek dosyayı güncelledim. İnceler misiniz?

 

[petsiye]

Evet tam olarak budur. Çok çok teşekkür ediyorum

 

[petsiye]

Merhaba,
Verdiğiniz kodlara İlave olarak aşağıdaki haliyle, userform tam ekran oluyor ve taşınamıyor. Katkı sağlamak adına iletiyorum.

Tekrar çok teşekkür ediyorum






Private Type Position
Left As Single
Top As Single
End Type



Private Sub UserForm_Layout()
Static Pos As Position
Dim Mvd As Boolean

If Pos.Left = 0 Or Pos.Top = 0 Then
Pos.Left = Me.Left
Pos.Top = Me.Top
Exit Sub
End If

Mvd = False
If Me.Left <> Pos.Left Then
Me.Left = Pos.Left
Mvd = True
End If
If Me.Top <> Pos.Top Then
Me.Top = Pos.Top
Mvd = True
End If


End Sub


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 = 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

Private Sub UserForm_Activate()
Me.Top = Application.Top
Me.Left = Application.Left
Me.Height = Application.Height
Me.Width = Application.Width
End Sub

 

[kykbt]

Arkadaşlar Merhaba
Benimde bir ricam olacaktı

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
trgadr = Target.Address: actsht = ActiveSheet.Name: sondolua = Range("a65536").End(3).Row
If Not Intersect(Target, Range("a6:a" & sondolua)) Is Nothing Then
sonsatır = ([A65536].End(3).Row)
    If ActiveCell.Value <> Empty Then
        With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            UserForm1.Top = ActiveSheet.Cells(ActiveCell.Row).Top + 250
            UserForm1.Left = ActiveSheet.Cells(ActiveCell.Column + 2).Left
        End With
        'UserForm1.Show
    Else    'ActiveCell.Value = Empty
        With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
            UserForm1.Top = ActiveSheet.Cells(ActiveCell.Row).Top + 250
            UserForm1.Left = ActiveSheet.Cells(ActiveCell.Column + 16).Left
        End With
    End If
Else
    'Unload UserForm1
    With Cells(Windows(1).ScrollRow, Windows(1).ScrollColumn)
        UserForm1.Top = ActiveSheet.Cells(ActiveCell.Row).Top + 250
        UserForm1.Left = ActiveSheet.Cells(ActiveCell.Column + 16).Left
    End With
End If
End Sub

Şeklinde bir kodum var.
Yapmak istediğim hangi hücreye tıkladı isem, user form o hücrenin sağında bir yere taşınsın.
Daha doğrusu tıkladığım sütunun yan sütunu üzerine taşınsın istiyorum.

Yukarıdaki kod ile taşınıyor ancak, bir müddet sonra user form çok uzaklaşıyor veya yakınlaşıyor.

 

[Korhan Ayhan]

Linkteki konular faydalı olabilir.

Userform' un sayfa içinde açılış pozisyonu

Merhabalar, Excel sayfasında userform' un açılacağı konumu belirlemek için; aşağıdaki linkte yer alan kodu buldum. yalnız userform açılınca; form'un altında sağında ve sağında şerit şeklinde beyaz boşluklar oluşuyor, bu boşlukları nasıl kaldırabiliriz...

www.excel.web.tr