UserForm Resize Özelliği Eklemek

26 Aralık 2020 26 Aralık 2020 1050

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 Sub

Gerekli Adımlar

Kodu çalıştırmanız için aşağıdaki adımları yerine getirmeniz gerekir.

  1. Microsoft Visual Basic for Applications penceresini (Alt + F11) açın.
  2. 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.
  3. Araç çubuklarından Insert -> UserForm yazısına tıklayın.
  4. Solunda klasör simgesi olan Forms yazısının başındaki + simgesine tıklayın.
  5. Alt kısma eklenecek olan UserForm(1) yazısına çift tıklayın.
  6. Ü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.

50 Farklı Hazır Makro (VBA) Kodu
Sayfadaki Ad Tanımlamaları Silme
Transparan UserForm Oluşturmak
Kullanıcı Adınızı Bulma
Bir sayfadaki Veriyi Diğer Sayfaya Aktarma
Tarih ve Saatten Saati Kaldırma
Sütunun Herhangi Hücresine Çift Tıklayınca UserForm Açılsın
Formu Kapatma Makro Kodu
Sürücü Adı Kontrolü Yapma
Çalışma Kitabını E-Posta Ekine Ekleme
Bir Değeri Renklendirme
Makrolar ile Klasör Oluşturma
İstenilen Şart Sağlanmıyorsa Kayıt Gerçekleşmesin
Hücredeki Değişikliklerin Kaydını Tutma
Kullanılan Tüm Sütunları Otomatik Sığdır
Dizileri İç İçe Döngüye Eklemek
Bilgisayar Bilgilerini Özetleme
Kaydedilmemiş Açık Çalışma Kitaplarını Sayma
Excel Hücresine Gitme Makrosu
Dosyanın Olduğu Dizin İsmini Bulma
Aktif Hücrenin Satır Numarasını Bulma
Seçimdeki Alternatif Satırları Vurgulama
Negatif Sayıları Vurgulama
Excel Üzerinden Klasör Alma Kodu
56 Renk Kodunu Sıralama
Sütun Genişliklerini Otomatik Ayarlama
Txt Dosyası Oluşturma
Excel Makroları ile Hücreye Saat Ekleme
Sayfaların Seçilmesini Sağlama
Birden Çok Çalışma Sayfası Ekleme
Her Kapatma İşleminde Otomatik Olarak Kaydetme
Özel Sayfaları Yazdırma
Makrolar ile Dosyaları Kopyalama
Yardım Menüsünü Açma
İçinde Bulunduğumuz AY Sayfasının Aktif Edilmesi
Excel Hücresini Seçme Makrosu
Boş Hücreleri Vurgulama
Excel Makroları ile Dosya Taşıma
R1C1 Referans Stilini Etkinleştirme
Çalışma Sayfalarını Alfabetik Olarak Sıralama
Sayıları Yeni Bir Sayıyla Çarpma
Birden Çok Sütun Ekleme
Kopyala ve Özel Yapıştır
Verileri Birden Çok Sütuna Göre Sıralama
Formüllü Hücreleri Renklendir
Makro ile Boş Satırları Silme
56 Koşula Kadar Biçimlendirme Yapma
Roma Rakamlarını Normal Sayılara Dönüştürme
Tüm Çalışma Kitaplarını Aynı Anda Kapatma
Bir Aralıktaki Minimum Değeri Renklendirme
Sayfadaki Grafikleri Yeniden Boyutlandırma

Daha önce yorum yapılmamış!

Backlink Reklam Bu alanda 50 karakterlik açıklama ile web sitenize ait Backlink Reklam yayınlayabilirsiniz.
Yükleniyor...