UserForm Resize Özelliği Eklemek
26 Aralık 2020
26 Aralık 2020
864
UserForm Resize Özelliği Eklemek isimli kodlar UserForm nesnenizi istediğiniz gibi boyutlandırmanızı sağlayacak niteliktedir.
Option Explicit
Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Label
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single
Private Sub m_AddResizer()
Set m_objResizer = Me.Controls.Add("Forms.label.1", MResizer, True)
With m_objResizer
With .Font
.Name = "Marlett"
.Charset = 2
.Size = 14
.Bold = True
End With
.BackStyle = fmBackStyleTransparent
.AutoSize = True
.BorderStyle = fmBorderStyleNone
.Caption = "o"
.MousePointer = fmMousePointerSizeNWSE
.ForeColor = RGB(100, 100, 100)
.ZOrder
.Top = Me.InsideHeight - .Height
.Left = Me.InsideWidth - .Width
End With
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub m_objResizer_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
m_sngLeftResizePos = X
m_sngTopResizePos = Y
m_blnResizing = True
End If
End Sub
Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
With m_objResizer
.Move .Left + X - m_sngLeftResizePos, .Top + Y - m_sngTopResizePos
Me.Width = Me.Width + X - m_sngLeftResizePos
Me.Height = Me.Height + Y - m_sngTopResizePos
.Left = Me.InsideWidth - .Width
.Top = Me.InsideHeight - .Height
End With
End If
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
m_blnResizing = False
End If
End Sub
Private Sub UserForm_Initialize()
m_AddResizer
End Sub
Private Sub UserForm_Terminate()
Me.Controls.Remove MResizer
End SubGerekli Adımlar
Kodu çalıştırmanız için aşağıdaki adımları yerine getirmeniz gerekir.
- Microsoft Visual Basic for Applications penceresini (Alt + F11) açın.
- Project - VBAProject alanının, ekranın sol tarafında görüldüğünden emin olun. Görünmüyorsa, Ctrl + R kısayolu ile hızlıca açın.
- Araç çubuklarından Insert -> UserForm yazısına tıklayın.
- Solunda klasör simgesi olan Forms yazısının başındaki + simgesine tıklayın.
- Alt kısma eklenecek olan UserForm(1) yazısına çift tıklayın.
- Üstteki kodu yapıştırın.
Kod Açıklaması
Üstteki kodları bir UserForm nesnesine eklerseniz, açıldığında boyutları ile istediğiniz gibi ekran üzerinden oynayabilirsiniz. 64 bit Ofis Sürümlerinde kodlar çalışmayabilir.
Etiketler :
| YARARLI KISAYOLLAR | |
|---|---|
| Bir Hücre Yukarı Git | ↑ |
| Satır ve Sütun Başlıklarını Gizleme Gösterme | Alt P Ü |
| Bitişik Olmayan Hücrelerde Sola Gitme | Ctrl Alt ← |
| TL Simgesi Eklemek | Ctrl Alt T |
| Özel Git Penceresini Açma | F5 |