Discussion :

[Master_x_99]

Bonjour

Je n'y comprend rien. J'avais pourtant résolu mon problème de changement de mot dans ma macro et le problème est réaparu

je vous poste mon code, en espérant que vous soyez capable de résoudre mon problème Merci à l'avance.

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
Sub generer_fichier()
'
' Generer_pages Macro.
'
 
 
 
Const Accents As String = "àâäåçéèêëîïôöùûüÈÉÊËÀÁÂÃÄÅÙÚÛÜ- ,"
Const Normaux As String = "aaaaceeeeiioouuuEEEEAAAAAAUUUU___"
 
 
    Dim c As Range, DerLigne As Integer, i As Byte
    Dim Ancien As String, Nouveau As String, Cible As String
    Dim VBComp As VBComponent
    Dim b As Integer
    Dim wbk As Workbook
    Dim w As Integer
    Dim Module As Object
 
 
    Sheets("Menu").Select
    DerLigne = Range("A65536").End(xlUp).Row
    For Each c In Range("A2:A" & DerLigne)
        For w = 1 To Len(Accents)
            c.Value = Replace(c.Value, Mid(Accents, w, 1), Mid(Normaux, w, 1))
        Next w
    Next c
 
 
    Sheets("Menu").Select
    ' Déterminer combien d'agent sur la feuille Menu
    FinalAgent = Range("A65000").End(xlUp).Row
 
    ' Loop pour chaque agent
    For x = 2 To FinalAgent
 
        Sheets("Menu").Select
        ThisAgent = Range("A" & x).Value
 
'Copie des feuilles
 
        Application.ScreenUpdating = False
        ThisWorkbook.Sheets(Array("Janvier", "Admin_Janvier", "Fevrier", "Admin_Fevrier", "Mars", "Admin_Mars", "Avril", "Admin_Avril", "Mai", "Admin_Mai", "Juin", "Admin_Juin", "Juillet", "Admin_Juillet", "Aout", "Admin_Aout", "Septembre", "Admin_Septembre", "Octobre", "Admin_Octobre", "Novembre", "Admin_Novembre", "Decembre", "Admin_Decembre", "AGT", "SGT")).Copy        'adapte les noms des feuilles
 
 
'Céation du nouveau fichier et enregistrement
        Set wbk = ActiveWorkbook
 
 
    Ancien = "New_Agt"
    Nouveau = "ThisAgent"
 
       For Each VBComp In wbk.VBProject.VBComponents
        With VBComp.CodeModule
            If VBComp.CodeModule.Name <> "AfficheMacrosActiveworkbook" Then
                For b = 1 To VBComp.CodeModule.CountOfLines
                    Cible = VBComp.CodeModule.Lines(b, 1)
                    Cible = Replace(Cible, Ancien, Nouveau)
                    VBComp.CodeModule.ReplaceLine b, Cible
                Next b
            End If
        End With
    Next VBComp
 
 
 
 
 
        Application.DisplayAlerts = False
        wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
 
 
 
 
 
 
Application.DisplayAlerts = True
 
 
 
wbk.Close
Set wbk = Nothing
 
 
    Next x
 
 
 
Application.ScreenUpdating = False
 
    Sheets("Menu").Select
    MsgBox ("Opération terminée.")
End Sub

Merci

[Stanler]

Bonjour,

Quel est le mot qui change ?

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
Sub generer_fichier()
'
' Generer_pages Macro.
'
Application.ScreenUpdating = False '=> A placer en début de macro.
Const Accents As String = "àâäåçéèêëîïôöùûüÈÉÊËÀÁÂÃÄÅÙÚÛÜ- ,"
Const Normaux As String = "aaaaceeeeiioouuuEEEEAAAAAAUUUU___"
    Dim c As Range, DerLigne As Integer, i As Byte
    Dim Ancien As String, Nouveau As String, Cible As String
    Dim VBComp As VBComponent
    Dim b As Integer
    Dim wbk As Workbook
    Dim w As Integer
    Dim Module As Object
 
    Sheets("Menu").Select '=> Est ce vraiment nécessaire ?
    DerLigne = Range("A65536").End(xlUp).Row
    For Each c In Range("A2:A" & DerLigne)
        For w = 1 To Len(Accents)
            c.Value = Replace(c.Value, Mid(Accents, w, 1), Mid(Normaux, w, 1))
        Next w
    Next c
    Sheets("Menu").Select '=> Encore la même ligne ?!
    ' Déterminer combien d'agent sur la feuille Menu
    FinalAgent = Range("A65000").End(xlUp).Row
    ' Loop pour chaque agent
    For x = 2 To FinalAgent
        Sheets("Menu").Select '=> Encore la même ligne ?!
        ThisAgent = Range("A" & x).Value
'Copie des feuilles
        ThisWorkbook.Sheets(Array("Janvier", "Admin_Janvier", "Fevrier", "Admin_Fevrier", "Mars", "Admin_Mars", "Avril", "Admin_Avril", "Mai", "Admin_Mai", "Juin", "Admin_Juin", "Juillet", "Admin_Juillet", "Aout", "Admin_Aout", "Septembre", "Admin_Septembre", "Octobre", "Admin_Octobre", "Novembre", "Admin_Novembre", "Decembre", "Admin_Decembre", "AGT", "SGT")).Copy        'adapte les noms des feuilles
 'Céation du nouveau fichier et enregistrement
        Set wbk = ActiveWorkbook
    Ancien = "New_Agt"
    Nouveau = "ThisAgent"
       For Each VBComp In wbk.VBProject.VBComponents
        With VBComp.CodeModule
            If VBComp.CodeModule.Name <> "AfficheMacrosActiveworkbook" Then
                For b = 1 To VBComp.CodeModule.CountOfLines
                    Cible = VBComp.CodeModule.Lines(b, 1)
                    Cible = Replace(Cible, Ancien, Nouveau)
                    VBComp.CodeModule.ReplaceLine b, Cible
                Next b
            End If
        End With
    Next VBComp 
Application.DisplayAlerts = False
wbk.SaveAs ThisWorkbook.Path & "\" & ThisAgent & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
wbk.Close
Set wbk = Nothing
     Next x
    Sheets("Menu").Select '=> Encore la même ligne ?!
Application.ScreenUpdating = True '=> A placer à la fin et il faut mettre "True"
MsgBox ("Opération terminée.")
End Sub

[Master_x_99]

Le mot New_AGT doit être remplacé par ThisAgent dans tout mon projet de mon nouveau classeur

Merci de ton aide

[Philippe PONS]

Salut,


Pourquoi dois tu changer un mot dans le module de code?
Tu es sur que tu ne peux pas le faire d'une façon plus simple?
Par exemple, en mettant ce nom dans une constante, ou en le lisant sur une feuille de calcul?
Cordialement,

[Invité]

Bonjour,
Appart que tu n' utilises pas l'option vbcompart pour les majuscules et les minuscules!
Place toi dans les parenthèses de replace( et appuis en même temps sur [Ctrl] et la barre d'espaces!

[Master_x_99]

En fait ThisAgent est une variable qui est changeante. Alors quand je crée une nouveau classeur New_AGT doit être remplacé par la variable ThisAgent.

Il n'est donc pas possible de cibler une cellule en particulier.