Ecriture d'un code événementiel depuis le classeur actif dans tous les autres classeurs ouverts

**janigrel** · 15/04/2018, 22h35

Bonjour à tous,

Je créé ici une nouvelle discussion suite à une première (https://www.developpez.net/forums/d1...port-userform/), car mon projet a évolué.

J'ai un fichier source qui me permet de créer de nouveaux classeurs (fiches client). Les utilisateurs finaux devront aller compléter un formulaire dans chaque fiche (USERFORM qui va être importé à l'ouverture de la fiche).
J'ai écrit un code qui créé chaque fiche, et qui doit écrire un code événementiel dans chacune des fiches (tous les classeurs ouverts sauf mon classeur de travail) avant de les enregistrer et de les fermer.

J'ai un problème avec mon code : les fiches sont bien sauvegardées, mais le code ne s'écrit pas dans "ThisWorkbook" de chaque fiche client.

Pouvez-vous m'aider à résoudre mon problème?
Merci d'avance.
Ci-dessous mon code et mon "fichier source"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
71
72
73
74
75
76
77
78
 
Option Explicit
 
 
' création d'une fiche, envoi des données du client dans la feuille1 du nouveau classeur
' et écriture d'un code événementiel (à l'ouverture) dans la fiche pour importer le USERFORM sauvegardé.
 
Public Sub Crea_Fiches()
Dim wb As Workbook
Dim wsSource As Worksheet, wsDesti As Worksheet
Dim lo As ListObject
Dim strPath As String, strFilename As String
Dim Cell As Range
Dim X As Integer
Dim ufPath As String
Dim CT As Workbook
Dim C As Workbook
 
    Application.ScreenUpdating = False
    ufPath = "d:tuto.frm"
    Set wb = ActiveWorkbook
    strPath = wb.Path & Application.PathSeparator
    Set wsSource = wb.Worksheets("SOURCE")
    Set lo = wsSource.ListObjects(1)
 
    Set wsDesti = wb.Worksheets("DESTI")
    Set CT = Workbooks("Fichier_source.xlsm") 'définit le classeur de travail
 
    For Each Cell In lo.ListColumns(4).DataBodyRange
        If UCase(Cell) = "OUI" Then
 
            With wsDesti
                .Cells(2, 1).Value = Cell.Offset(, -3).Value
                .Cells(2, 2).Value = Cell.Offset(, -2).Value
                .Cells(2, 3).Value = Cell.Offset(, -1).Value
                .Cells(2, 4).Value = Cell.Offset(, 1).Value
                strFilename = .Cells(2, 1).Value & "_" & .Cells(2, 2).Value
            End With
            wsDesti.Copy
 
                      'Ecriture d'un code événementiel dans Thisworkbook de chaque nouveau classeur créé
                        For Each C In Application.Workbooks 'boucle sur tous les classeurs ouverts
                            If Not wb.Name = CT.Name Then 'condition : si le classeur n'est pas CT
 
                                With C.VBProject.VBComponents("ThisWorkbook").CodeModule
                                    X = .CountOfLines
                                    .InsertLines X + 1, "Private Sub Workbook_Open"
                                    .InsertLines X + 2, "ActiveWorkbook.VBProject.VBComponents.Import ufPath"
                                    .InsertLines X + 3, "End Sub"
                                End With
                            End If
                        Next C
 
 
            With ActiveWorkbook
                .Worksheets(1).Name = strFilename
                .SaveAs strPath & strFilename, 52
 
            End With
        End If
 
    Next Cell
 
    For Each C In Application.Workbooks 'boucle sur tous les classeurs ouverts
        If Not C.Name = CT.Name Then 'condition : si le classeur n'est pas CT
        C.Close
        End If
     Next C
 
 
    With wsDesti
        .Cells(2, 1).Value = ""
        .Cells(2, 2).Value = ""
        .Cells(2, 3).Value = ""
        .Cells(2, 4).Value = ""
    End With
 
End Sub