Makroları Listelemek

[Seyit Tiken]

Selamün Aleyküm,
Arkadaşlar, birden fazla makroyu UserForm üzerindeki ListBox'da listeleyip(sıralayıp) çalıştırabilir miyiz?, örnek olarak, makro1'e tıkladığımızda makro1 çalışsın, makro2'ye tıkladığımızda makro2 çalışsın, yardımlarınız için şimdiden teşekkür ediyorum.

 

[halit3]

Küçük bir ornek ekliyorum ayrıntılarını sen halledersin herhalde

3 -adet listbox nesnesi
1-adet commandbutton

Private Sub CommandButton1_Click()
On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
For n = 1 To VBCodeMod.CountOfLines
deger6 = WorksheetFunction.Trim(ThisWorkbook.VBProject.VBComponents(VBCodeMod).CodeModule.Lines(n, 1))
If Mid(deger6, 1, 11) = "Private Sub" Then
ListBox3.AddItem VBCodeMod
ListBox2.AddItem deger6
ListBox1.AddItem Mid(deger6, 13, Len(deger6) - 14)
ElseIf Mid(deger6, 1, 8) = "Function" Then
ListBox2.AddItem deger6
ListBox1.AddItem deger6
End If
Next
Next
MsgBox ListBox1.ListCount & " adet makro kodu bulundu işlem tamam"
End Sub

 

[Seyit Tiken]

Halit bey çok teşekkür ediyorum, tek listBox yapılabilir mi?

 

[halit3]

Böylemi istiyorsunuz.

Private Sub CommandButton1_Click()
On Error Resume Next
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
For n = 1 To VBCodeMod.CountOfLines
deger6 = WorksheetFunction.Trim(ThisWorkbook.VBProject.VBComponents(VBCodeMod).CodeModule.Lines(n, 1))
If Mid(deger6, 1, 11) = "Private Sub" Then
ListBox1.AddItem Mid(deger6, 13, Len(deger6) - 14)
ElseIf Mid(deger6, 1, 8) = "Function" Then
ListBox1.AddItem deger6
End If
Next
Next
MsgBox ListBox1.ListCount & " adet makro kodu bulundu işlem tamam"
End Sub

 

[halit3]

yada böyle

Private Sub CommandButton1_Click()
ListBox1.Clear
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "70;150;100;0" 'lisbox'taki sütunların genişliği
sat1 = 0
For Each ModX In ActiveWorkbook.VBProject.VBComponents
Set VBComp = ActiveWorkbook.VBProject.VBComponents(ModX.Name)
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ModX.Name).CodeModule
For n = 1 To VBCodeMod.CountOfLines
deger6 = WorksheetFunction.Trim(ThisWorkbook.VBProject.VBComponents(VBCodeMod).CodeModule.Lines(n, 1))
If Mid(deger6, 1, 11) = "Private Sub" Then
ListBox1.AddItem
ListBox1.List(sat1, 0) = VBCodeMod
ListBox1.List(sat1, 1) = deger6
ListBox1.List(sat1, 2) = Mid(deger6, 13, Len(deger6) - 14)
sat1 = sat1 + 1
ElseIf Mid(deger6, 1, 8) = "Function" Then
ListBox1.AddItem
ListBox1.List(sat1, 0) = VBCodeMod
ListBox1.List(sat1, 1) = deger6
ListBox1.List(sat1, 2) = deger6
sat1 = sat1 + 1
ElseIf Mid(deger6, 1, 3) = "Sub" Then
ListBox1.AddItem
ListBox1.List(sat1, 0) = VBCodeMod
ListBox1.List(sat1, 1) = deger6
ListBox1.List(sat1, 2) = Mid(deger6, 5, Len(deger6) - 6)
sat1 = sat1 + 1
End If
Next
Next
MsgBox ListBox1.ListCount & " adet makro kodu bulundu işlem tamam"
End Sub

 

[Seyit Tiken]

Halit bey çok teşekkür ediyorum, sağolun, kolay gelsin.