Assemblage de macro

Version imprimable

Assemblage de macro

Bonjour à tous,

Merci à ceux qui lisent ces lignes.
Je créé une macro qui va modifier un code VBA dans un classeur dont le projet est protégé par mot de passe.
Après quelques recherches sur internet et un peu de bricolage, j'ai réussi à créer :

-une macro pour déprotéger le classeur
-une macro pour modifier le code
-une macro pour reprotéger le classeur

Chacune des macros fonctionne quand elles sont exécutées une à une :lol: .
Mais lorsques je créé une macro pour les exécuter en "une fois". La macro plante ! :oops:

Voici les codes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
 
'pour déprotéger le projet d'un classeur
 
Sub macro1()
    Dim classeur2 As String
    Dim Wb As Workbook
    classeur2 = ActiveWorkbook.Name
    Set Wb = Workbooks(classeur2)
    UnprotectVBProject Wb, "motdepasse"
    MsgBox "déprotection ok"
End Sub
 
Sub UnprotectVBProject(Wb As Workbook, ByVal Password As String)
    Dim vbProj As Object
    Set vbProj = Wb.VBProject
    If vbProj.Protection <> 1 Then Exit Sub
    Set Application.VBE.ActiveVBProject = vbProj
    SendKeys Password & "~~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub
 
'pour reprotéger le projet d'un classeur
 
Sub macro2()
    Dim classeur2 As String
    Dim Wb As Workbook
    classeur2 = ActiveWorkbook.Name
    Set Wb = Workbooks(classeur2)
    ProtectVBProject Wb, "motdepasse"
    MsgBox "protection ok"
End Sub
 
Sub ProtectVBProject(Wb As Workbook, ByVal Password As String)
    Dim vbProj As Object
    Set vbProj = Wb.VBProject
    If vbProj.Protection = 1 Then Exit Sub
    Set Application.VBE.ActiveVBProject = vbProj
    DoEvents
    SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~"
    'SendKeys Password & "~~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    DoEvents
End Sub
 
'macro à exécuter pendant que le classeur est déprotégé
 
Sub creationMacroOuverture(cible As String)
Sheets("Stats").Select
Dim a, x As Integer
Dim Nom As String
For a = 1 To ThisWorkbook.VBProject.VBComponents.Count
Nom = ThisWorkbook.VBProject.VBComponents.Item(a).Name
If ThisWorkbook.VBProject.VBComponents.Item(a).Name <> "UserFormListe" Then
    ThisWorkbook.VBProject.VBComponents.Item(a).Activate
        If ActiveSheet.Name = cible Then Exit For
End If
Next
 
With ActiveWorkbook.VBProject.VBComponents(a).CodeModule
    x = .CountOfLines
        .InsertLines x + 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
        .InsertLines x + 2, "If Target.Column = 1 And Target.Row > 2 Then"
        .InsertLines x + 3, "    Dim NuméroAliment As String"
        .InsertLines x + 4, "    NuméroAliment = Range(Target.Address).Value"
        .InsertLines x + 5, "    Module2.définitive (NuméroAliment)"
        .InsertLines x + 6, "End If"
        .InsertLines x + 7, "End Sub"
End With
 
End Sub

Et le code suivant ne fonctionne pas :

Code:

1
2
3
4
5
Sub GENERAL(cible As String)
macro1
creationMacroOuverture (cible)
macro2
End Sub

Si certaines personnes ont la solution, je suis preneur.
Merci d'avance!!

Coco

Bonsoir

Ci-joint une proposition (issue de tes codes)

Ouverture d'un classeur, deprotection de son projet vba, écriture éventuelle du code dans la feuille dont le CodeName est Feuil1, re-protection du projet vba et sauvegarde et ferméture du classeur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
'Nécessite d'activer la référence
'Microsoft "Visual basic For Application Extensibility 5.3"
Sub Macro1()
Dim Wb As Workbook
Dim Chemin As String, Fichier As String, MdP As String
Dim vbProj As Object
Dim vbComp As VBComponent
Dim x As Integer
 
Chemin = "C:\Users\user\Desktop\"                                    '!!!!A adapter
Fichier = "test1.xlsm"                                               '!!!!A adapter
MdP = "toto"                                                         '!!!!A adapter
 
'OUVERTURE FICHIER A TRAITER-------------------------------------------
Set Wb = Workbooks.Open(Chemin & Fichier)
 
'DEPROTECTION----------------------------------------------------------
Set vbProj = Wb.VBProject
If vbProj.Protection = 1 Then
    Set Application.VBE.ActiveVBProject = vbProj
    SendKeys MdP & "~~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    MsgBox "Deprotection ok"
End If
 
'ECRITURE CODE SI INEXISTANT--------------------------------------------
Set vbComp = Wb.VBProject.VBComponents.Item("Feuil1")                '!!!!Feuil1 est le CodeName de la feuille et non son Name
With vbComp.CodeModule
    x = .CountOfLines
    If Not .Find("Worksheet_SelectionChange", 1, 1, .CountOfLines, 3) Then
        .InsertLines x + 1, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
        .InsertLines x + 2, "Dim NumeroAliment As String"
        .InsertLines x + 4, "    If Target.Column = 1 And Target.Row > 2 And Target.Count = 1 Then"
        .InsertLines x + 5, "        NumeroAliment = Target.Value"
        .InsertLines x + 6, "        Module2.définitive (NumeroAliment)"
        .InsertLines x + 7, "    End If"
        .InsertLines x + 8, "End Sub"
        MsgBox "Ecriture code ok"
    Else
        MsgBox "Code déjà existant"
    End If
End With
Set vbComp = Nothing
 
'PROTECTION------------------------------------------------------------
DoEvents
SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & MdP & "{TAB}" & MdP & "~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
DoEvents
MsgBox "Protection ok"
 
'SAUVEGARDE ET FEMETURE-------------------------------------------------
Set vbProj = Nothing
Wb.Close True
Set Wb = Nothing
MsgBox "Opération terminée avec succès"
End Sub

01/06/2011, 22h52
Pierre Fauconnier
Salut.

Si le but est de comprendre pourquoi cela ne fonctionne pas lorsque tu les assembles, ce serait bien de nous dire "ce qui ne fonctionne pas".

Message d'erreur? Si oui, sur quelle ligne? etc... :roll:

Ceci dit, il y des trucs bizarres dans ton code
Code:

1 2 classeur2 = ActiveWorkbook.Name Set Wb = Workbooks(classeur2)
Tu pourrais faire de suite

Code:

set wb = activeworkbook

Fais attention également que tu utilises ActiveWorkbook et ThisWorkbook. Ces objets ne pointent pas toujours vers le même classeur.

Chaque macro, lancée séparément, peut donc bien fonctionner, mais en les chaînant, le ThisWorkbook de creationMacroOuverture n'est peut-être pas le même que lorsque tu lances cette macro manuellement.
27/06/2011, 15h45
coconuts_n

merci

Citation:

Envoyé par Pierre Fauconnier

Fais attention également que tu utilises ActiveWorkbook et ThisWorkbook. Ces objets ne pointent pas toujours vers le même classeur.

C'était effectivement le problème.

Merci (avec du retard, je n'avais pas eu de mail signalant vos réponses, désolé)

Merci aussi à Mercatog s'être pencher dessus !

Super Forum !

Coco