I Comment insérer un module ?

II Comment tester un module ?

III Comment supprimer un module ?

I Comment insérer un module?

Comment insérer un module et construire une macro dans ce module?
Cette macro (de Laurent Longre) écrit une macro dans un nouveau classeur:
Daniel

Sub EcritSUB() 'Ecrit directement dans 1 nouveau classeur
Dim Wbk As Excel.Workbook
Dim Code, I As Integer
Code = Array("Sub Test()", _
"Msgbox ""Je suis une macro.""", _
"End Sub")
Set Wbk = Workbooks.Add
With Wbk.VBProject.VBComponents.Add(vbext_ct_StdModule)
For I = 0 To 2
.CodeModule.InsertLines I + 1, Code(I)
Next I
End With
Wbk.SaveAs "C:\ajeter\Test.xls"
End Sub

IMPORTANT

Avant de tester cet exemple, faire Outils ->Références
et cocher la ligne'"Visual Basic for Applications Extensibility".
Ou bien:
Microsoft Visual Basic For Applications Extensibility 5.3" (Excel 2000).

Il est possible aussi de se passer de cette référence avec cette astuce:

Remplacer vbext_ct_StdModule par 1.
Ca donne :
With Wbk.VBProject.VBComponents.Add(1)
au lieu de :
With Wbk.VBProject.VBComponents.Add(vbext_ct_StdModule)
Eric Jeanne

Walkenbach a écrit des choses sur comment créer un userForm par VBA :
http://www.j-walk.com/ss/excel/tips/tip76.htm

et Chip Pearson sur la création programmée de modules.
http://www.cpearson.com/excel/vbe.htm

Et pour cocher automatiquement la référence ?

Si tu as vraiment besoin de cocher la librairie Microsoft Visual Basic Extensibility, essaye de modifier le code de Daniel comme ci-dessous.
Il reste nécessaire de déclarer la constante vbext_ct_StdModule pour que le module soit effectivement ajouté sans erreur,< l'ajout de la référence n'est pas suffisant.
Il faudrait peut-être déclencher l'événement ItemAdded de la collection References pour éviter ça mais je ne sais pas faire.

La référence est ajoutée pour Excel 2000 et, normalement, pour Excel 97 SR-2.
Frédéric Sigonneau [né un Sans-culottide !]

MODIFICATION
Sub EcritSUB() 'pour ecrire directement dans 1 new classeur
Const vbext_ct_StdModule = 1
Dim Wbk As Excel.Workbook, pathVBAExtensibility$
Dim Code, I As Integer

Code = Array("Sub TestVBA()", _
"Msgbox ""Je suis une macro.""", _
"End Sub")

Set Wbk = Workbooks.Add

'chemin de la librairie Visual Basic Extensibility
#If VBA6 Then
pathVBAExtensibility = _
"C:\PROGRA~1\FICHIE~1\MICROS~1\VBA\VBA6\Vbe6ext.olb"
#Else 'Ok pour Excel 97 SR-2
pathVBAExtensibility = _
"C:\PROGRAM FILES\FICHIERS COMMUNS\MICROSOFT SHARED\VBA\VBEEXT1.OLB"
#End If
'ajouter la référence
Wbk.VBProject.References.AddFromFile pathVBAExtensibility

With Wbk.VBProject.VBComponents.Add(vbext_ct_StdModule)
For I = 0 To 2
.CodeModule.InsertLines I + 1, Code(I)
Next I
End With
Wbk.SaveAs "C:\Windows\Bureau\TestExt.xls"
End Sub

======================
Excellent, Frédéric.
J'ai dû toutefois modifier chez moi l'adresse en
"C:\Program Files\Common Files\MicroSoft Shared\VBA\VBA6\Vbe6ext.olb"
Eric Jeanne
======================
Faites l'essai avec
With Wbk.VBProject.VBComponents.Add(vbext_ct_StdModule)
With Wbk.VBProject.VBComponents.Add(1)

, " (vbext_ct_StdModule)" ne sert pas si on met le( 1)
Donc cela marche très bien comme ça.
Sans avoir besoin de cocher la référence ni de la déclarer
La macro finale était donc
(la référence n'est toujours pas cochée à la fin d'ailleurs.)

Sub EcritSUB() 'pour ecrire directement dans 1 new classeur
Dim Wbk As Excel.Workbook
Dim Code, I As Integer
Code = Array("Sub Test()", _
"Msgbox ""Je suis une macro.""", _
"End Sub")
Set Wbk = Workbooks.Add
With Wbk.VBProject.VBComponents.Add(1)
For I = 0 To 2
.CodeModule.InsertLines I + 1, Code(I)
Next I
End With
Wbk.SaveAs "C:\ajeter\Test.xls"
End Sub

Amicalement
à tous et merci encore
Laurent (de Marseille)

II Comment tester un module ?

Et comment tester l'existence d'une macro?

Une piste avec cette macro de Laurent:
Daniel

'La fonction ChProcs(Wbk, Type_procs) renvoie un tableau de N lignes sur
'2 colonnes (N = nombre de procédures ou de fonctions contenues dans le 'classeur Wbk)
'- 1ère colonne : module de code de la procédure (objet CodeModule)
'- 2ème colonne : nom de la procédure ou de la fonction (chaîne de 'caractères)
'L 'argument Type_procs indique le type de procédure que l'on cherche
'(xlCommand pour les procédures ou xlFunction pour les fonctions).
'Par exemple, pour placer dans la variable "MesProcs" toutes les 'procédures Sub du classeur actif:

'MesProcs = ChProcs(ActiveWorkbook, xlCommand)

'Quelques remarques:
'- La procédure ChProc ne prend pas en compte les procédures ou fonctions
'déclarées "Private". Si tu veux qu'elle les prenne en compte, élimine
'simplement la ligne [If Not .Find("Private ", Body, 0, Body + 1, 0)
'Then] et le [End If] correspondant.

'- D'autre part, elle n'identifie que les procédures ou fonctions
'stockées dans des modules standard. Elle ignore donc celles qui se
'trouvent dans des modules de classe, de feuilles ou de UserForms.

'Si tu veux que *tous les types* de modules soient analysés, supprime la
'ligne [If VBC.Type = vbext_ct_StdModule Then] et le [End If]
''remplace dans ce test la constante vbext_ct_StdModule par au choix:

' . vbext_ct_ClassModule pour les modules de classe
' . vbext_ct_MSForm pour les UserForms
' . vbext_ct_Document pour les modules de feuilles de calcul

'La procédure Test() est juste une macro d'essai, qui inscrit dans la
'feuille active les noms de toutes les procédures Sub publiques des 'modules standard du classeur.

' '***** POUR QUE CETTE MACRO FONCTIONNE *****, il est IMPERATIF de faire
'd 'abord la manip suivante: dans l'éditeur VBA, active le menu Outils =>
'Références, coche la ligne intitulée "Microsoft Visual Basic For 'Applications Extensibility" et valide par OK.

'Laurent

Option Base 1

Sub Test()
Dim Procs
Range("A:IV").Clear
Procs = ChProcs(ActiveWorkbook, xlCommand)
If IsEmpty(Procs) Then
MsgBox "Aucune procédure trouvée"
Else
Application.ScreenUpdating = False
[A1:B1] = [{"MODULE","PROCEDURE"}]
[A1:B1].Font.Bold = True
With Range("A2:B" & UBound(Procs) + 1)
.Value = Procs
.Sort Range("A2"), , Range("B2")
End With
End If
End Sub

Function ChProcs(Wbk As Workbook, Type_procs As Long)

Dim VBC 'As VBComponents
Dim I As Integer, NbProcs As Integer
Dim Proc As String, Procs()
Dim Start As Long, Body As Long
Dim TypeTexte As String
Select Case Type_procs
Case xlCommand
TypeTexte = "Sub "
Case xlFunction
TypeTexte = "Function "
Case Else
Exit Function
End Select
For Each VBC In Wbk.VBProject.VBComponents
If VBC.Type = vbext_ct_StdModule Then
With VBC.CodeModule
Start = .CountOfDeclarationLines + 1
Do While Start < .CountOfLines
Proc = .ProcOfLine(Start, vbext_pk_Proc)
Body = .ProcBodyLine(Proc, vbext_pk_Proc)
If .Find(TypeTexte, Body, 0, Body + 1, 0) Then
If Not .Find("Private ", Body, 0, Body + 1, 0) Then
NbProcs = NbProcs + 1
ReDim Preserve Procs(2, NbProcs)
Set Procs(1, NbProcs) = VBC.CodeModule
Procs(2, NbProcs) = Proc
End If
End If
Start = Start + .ProcCountLines(Proc, vbext_pk_Proc)
Loop
End With
End If
Next VBC
If NbProcs = 1 Then
Dim Res(1, 2)
Set Res(1, 1) = Procs(1, 1)
Res(1, 2) = Procs(2, 1)
ChProcs = Res
ElseIf NbProcs > 1 Then
ChProcs = WorksheetFunction.Transpose(Procs)
End If
End Function

====================
Sinon voici une macro testée sur Excel2000 (adaptée d'un code trouvé ici
http://www.cpearson.com/excel/vbe.htm

Voici une nouvelle tentative avec un masque de saisie pour entrer le nom de
la macro cherchée dans le classeur actif :
Cordialement
Pascal dit Papou

Sub Recherche_Macro()
'Ajouter une référence à Microsoft VisualBasic For Application Extensibility 5.3
(Menu 'Outils|Références de l'éditeur VBA)

If ActiveWorkbook.Name = ThisWorkbook.Name Then
MsgBox "Le classeur actif ne doit pas contenir la macro Recherche_Macro", vbInformation + vbOKOnly, "Arrêt"
Exit Sub
End If
Dim Saisie, LeNom As String
Saisie = InputBox("Saisir le nom de la macro cherchée" & vbLf & "en respectant les majuscules / minuscules")
If Saisie = "" Then Exit Sub
LeNom = "Sub " & Saisie
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim RechercheLaMacro
Dim i As Integer, y As Integer
For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(i).CodeModule
With VBCodeMod
For y = 1 To .CountOfLines
StartLine = .CountOfDeclarationLines + 1
RechercheLaMacro = .Find(LeNom, StartLine, 1, .CountOfLines, -1, True, True, False)
Next
End With
Next

If RechercheLaMacro = True Then
GoTo trouve
Else
GoTo pastrouve
End If

Exit Sub
trouve:
MsgBox "La macro " & Saisie & " est bien dans le classeur " & ActiveWorkbook.Name
Exit Sub

pastrouve:
MsgBox "La macro " & Saisie & " n'est pas dans le classeur " & ActiveWorkbook.Name
Exit Sub
End Sub
=======================

à partir du code de Chip Pearson (en passant le nom de la procédure à chercher en paramètre) :
Frédéric Sigonneau [né un Sans-culottide !]
Fonctionne trés bien

Sub ChercheProcedure(NomProc$)
'nécessite une référence à Microsoft Visual Basic Extensibility
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim Msg As String, Ret$, done As Boolean
Dim ProcName As String

For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count
Set VBCodeMod = _
ThisWorkbook.VBProject.VBComponents(i).CodeModule
With VBCodeMod
StartLine = .CountOfDeclarationLines + 1
Do Until StartLine >= .CountOfLines
Msg = .ProcOfLine(StartLine, vbext_pk_Proc)
If Msg = NomProc Then
Ret = "La procédure '" & NomProc & "' est dans le module '"
Ret = Ret & .Parent.Name & "' de ce classeur."
MsgBox Ret
done = True
Exit Do
End If
StartLine = StartLine + .ProcCountLines(.ProcOfLine(StartLine, _
vbext_pk_Proc), vbext_pk_Proc)
Loop
End With
Next

If Not done Then _
MsgBox "La procédure '" & NomProc & "' n'existe pas dans ce classeur"
End Sub

'Le test à executer pour rechercher la procèdure nommée Zaza

Sub testZaza()
ChercheProcedure "Zaza"
End Sub

III Comment supprimer un module?

Comment supprimer un module nommé Toto du classeur test.xls?

Sub Supprime_Module()
Workbooks.Open "C:\Temp\Test.xls"
On Error Resume Next
With ActiveWorkbook.VBProject.VBComponents
.Remove .Item("Toto")
End With
On Error GoTo 0
End Sub

La boucle est bouclée !!!

[top]