SAĞ TIK İKON EKLEME

Описание: Excel VBA Projelerinizde Userform da kullanacağınız Listbox nesnelerinde Sağ Tık Menüsü Oluşturmak ve İkon Eklemek ile alakalı olan 2 serilik videomun 2.si. Umarım Beğenirsiniz.

----------------------------------- Bu Kodlar Module 1 'in İçine -------------------------------

Public txtObj As MSForms.ListBox

Public Sub tbox_Yeni()
frmKasaYeni.Show
End Sub

Public Sub tbox_Giris()
If frmKasalar.ListBox1.ListIndex (farklıysa) -1 Then frmKasaGiris.ComboBox1 = frmKasalar.ListBox1.List(frmKasalar.ListBox1.ListIndex, 2)

frmKasaGiris.Show
End Sub

Public Sub tbox_Cikis()
If frmKasalar.ListBox1.ListIndex (Farklıysa) -1 Then frmKasaCikis.ComboBox1 = frmKasalar.ListBox1.List(frmKasalar.ListBox1.ListIndex, 2)
frmKasaCikis.Show
End Sub

Public Sub tbox_AnaMenu()
Unload frmKasalar
End Sub

-------------------------------------- Modüle 1 Burada Bitti --------------------------------------------


-------------------------------------- AŞAĞIDA USERFORM 1 KODLARI -------------------------------

Const menuName As String = "tempMenu"



Private Sub CommandButton1_Click()
Unload Me ' KAPAT BUTONU
End Sub

Sub deleteMenu()
On Error Resume Next
CommandBars(menuName).Delete
On Error GoTo 0
End Sub

Sub PopRightClickMenu()

deleteMenu

With CommandBars.Add(menuName, msoBarPopup)
With .Controls.Add(msoControlButton)
.OnAction = "tbox_Yeni"
.Caption = "Yeni Ekle"
.FaceId = 18
End With
With .Controls.Add(msoControlButton)
.OnAction = "tbox_Giris"
.Caption = "Kasa Giriş"
.FaceId = 137
End With
With .Controls.Add(msoControlButton)
.OnAction = "tbox_Cikis"
.Caption = "Kasa Çıkış"
.FaceId = 138
End With
With .Controls.Add(msoControlButton)
.OnAction = "tbox_AnaMenu"
.Caption = "Çıkış"
.FaceId = 840
End With
.ShowPopup
End With
deleteMenu
End Sub


Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
If Button = 2 Then 'SAĞ TIK İSE
Set txtObj = frmKasalar.ListBox1
PopRightClickMenu
End If
End Sub

Private Sub ListBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
If Button = 2 Then 'SAĞ TIK İSE
Set txtObj = frmKasalar.ListBox2
PopRightClickMenu
End If
End Sub


Private Sub UserForm_Terminate()
Set txtObj = Nothing
End Sub




Yazdığım Programlar Hoşunuza Giderse veya Kendiniz İçin Özel Program Yazdırmak İsterseniz Benimle İletişime Geçebilirsiniz.

Video işinize yaradıysa desteğinizi göstermek adına beğenmeyi ve kanala abone olmayı unutmayın. Yeni yükleyeceğim videolarımdan haberdar olmak için bildirimleri açınız.

Mail ( Contact ) - [email protected]