La Famille des Barbatrucs s'agrandit...

skoobi

XLDnaute Barbatruc
Re : La Famille des Barbatrucs s'agrandit...

Salut Michel :), Brigitte :), Hervé:),

quand je vois ceux de Hasco, Skoobi, Tototiti, j'vous raconte pas "si raconte"').
Moi je peux te faire un roman si tu veux :p:D.

Tiens Hervé, tu ne saurai pas comment aller chercher le nom d'une macro et se mettre dessus directement (ou si quelqu'un sait).

Il me semble qu'il faut chercher par thisworkbook.VBProject.VBComponents
Si j'ai un moment demain je regarde ;).
 

Hervé

XLDnaute Barbatruc
Re : La Famille des Barbatrucs s'agrandit...

salut à tous :)

Michel :

Tiens Hervé, tu ne saurai pas comment aller chercher le nom d'une macro et se mettre dessus directement (ou si quelqu'un sait).

avec l'usine à gaz (toute pas belle) qui suit j'ouvre le module ou se trouve la macro appelée par le double-clic sur la listbox3.

pas arrivé à mieux :D

on doit simplifié ce foin tres simplement en créant une listbox3 à deux colonnes 1er=nom de la macro 2ème=numéro du module (le i de la boucle de MICHELXLD)

je te laisse faire.

Code:
Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Mdl As Object
Dim i As Integer, Y As Integer
Dim X As Byte
Dim Cible As String
Dim tablo()
Dim t As String
For i = 0 To ListBox3.ListCount - 1
    If ListBox3.Selected(i) = True Then t = ListBox3.List(i, 0)
Next i
If t = "" Then Exit Sub
For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
    Set Mdl = ActiveWorkbook.VBProject.VBComponents(i).CodeModule
    With Mdl
        For Y = 1 To .CountOfLines
            Cible = ActiveWorkbook.VBProject.VBComponents(Mdl).CodeModule.Lines(Y, 1)
            Cible = Application.Substitute(Cible, " ", "")
            If Len(Application.Substitute(Cible, "Sub", "")) < Len(Cible) Then
                If Left(Cible, 3) = "Sub" Or Left(Cible, 7) = "Private" Then
                    X = X + 1
                    ReDim Preserve tablo(1 To 2, 1 To X)
                    tablo(1, X) = ActiveWorkbook.VBProject.VBComponents(Mdl).CodeModule.Lines(Y, 1)
                    tablo(2, X) = i
                End If
            End If
        Next
    End With
Next
For i = 1 To UBound(tablo, 2)
    If tablo(1, i) = t Then
        Application.VBE.ActiveVBProject.VBComponents(tablo(2, i)).CodeModule.CodePane.Show
    End If
Next i
End Sub

salut

ps : tata, promis, j'ouvre MSN ce soir, bisous
 

MJ13

XLDnaute Barbatruc
Re : La Famille des Barbatrucs s'agrandit...

Bonjour Skoobi, Brigitte, Hervé

Skoobi: Je confirme cela va bientôt être une bible pour toi:rolleyes:.

Brigitte: j'suis pas trop Newsletter. Je regarderai de temps en temps:confused:.

Hervé: Merci pour ce code digne d'un grand Xldien (merci aussi à MichelXLD en passant).
Je viens de tester, y'a de l'dée, mais bon il faudra que je trouve en faisant peut être un mixte:eek:.

Bonne soirée.
 

skoobi

XLDnaute Barbatruc
Re : La Famille des Barbatrucs s'agrandit...

Salut Michel, Hervé,

je vois que Hervé a pris de l'avance, je mets quand même:

Code:
Sub test()
'Nom du 3eme module
Nom = Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(3).Name
'Nombre de lignes du 3eme module
NbLig = Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(3).CodeModule.CountOfLines
'cherche le texte dans le 3eme module -> vrai ou faux
Trouve = Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(1).CodeModule.Find("CBT_trier_Click", 1, 1, 178, 500)
'renvoi la ligne de la procédure cherchée
Lig = Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(3).CodeModule.ProcBodyLine("CBT_trier_Click", vbext_pk_Proc)
'active la fenêtre du module
Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(3).CodeModule.CodePane.Window.SetFocus
'sélection dans un module
Workbooks("TriBDD_v1.1.xla").VBProject.VBComponents(3).CodeModule.CodePane.setSelection Lig, 1, Lig, 52
End Sub
Si ça peut aussi t'aider.
 

MJ13

XLDnaute Barbatruc
Re : La Famille des Barbatrucs s'agrandit...

Bonjour Skoobi (ou Re je ne sais plus).

Merci pour ce code que je tenterai d'utiliser, mais où va tu chercher ces trouvailles?:cool:
 

Statistiques des forums

Discussions
315 099
Messages
2 116 210
Membres
112 687
dernier inscrit
snexedwards