Discussion :

[Tekiila_67]

Bonjour à tous,

Nouveau sur le forum car c'est la première fois que j'utilise VBA, j'ai pu travailler environ 12h en cours en C++ mais je n'ai jamais réalisé quoi que ce soit sur VBA.
Je suis ingénieur consultant, et mon métier me demande d'aller dans différentes entreprises pour assurer une réponse à un besoin.
Une tâche annexe à mon travail étant sur VBA, j'ai réussi à faire tout ce dont j'avais besoin de faire grâce à internet (eh oui, merci G...... et les forums) mais je bloque à la phase finale.

En gros, j'ai un fichier appelé OT (ordre de travail) que j'ai du modifier dans un nouveau format d'impression. Je dois désormais passer les anciens fichiers OT dans le nouveau format, ce qui correspond à environ 130 fichiers.
J'ai réalisé la macro pour un fichier, ce qui fonctionne très bien. Maintenant je voudrais que lorsque j'appuie sur le bouton TRANSFERT_TOUT que j'ai ajouté au développeur, que la macro recherche tous les fichiers .xlsm dans un repertoire ET dans les dossiers et sous dossiers, et effectue la macro nommée TRANSFERT.

Voici mon code actuel

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
 
Sub TRANSFERT_TOUT()
 
Dim repertoire As String
Dim unFichier As String
Dim wbook As Workbook
 
repertoire = "C:\Users\....\Dossier transfert XLSM\"    'Ceci est un dossier temporaire d'essai dans lequel j'ai inséré 3 fichiers .xlsm pour vérifier si tout marche bien.
unFichier = Dir(repertoire & "*.xlsm")
 
Do While unFichier <> ""
    Workbooks.Open repertoire & unFichier, Updateslinks = False
    Application.ScreenUpdating = False
    Call TRANSFERT                                                    ' TRANSFERT étant la macro pour modifier un fichier dans le nouveau format
    Workbooks(unFichier).Close False
    unFichier = Dir                    
Loop
End Sub

Lorsque je clique sur TRANSFERT_TOUT, Excel ouvre bien le premier fichier du repertoire que j'ai indiqué, effectue bien la macro, puis ferme le fichier, mais plus rien après.
J'ai déjà tout fouillé sur le net, j'ai essayé avec les parenthèses après le Dir aussi, j'ai essayé d'autres fonctions, mais rien à faire.
Certaines fois, au niveau du Dir final j'ai une erreur d'execution 5 "Appel de procédure ou argument incorrect" et en fouillant sur le net j'ai l'impression d'avoir tout bien rédigé comme il faut.

Voila donc où je bloque, et si vous pouviez m'aider.
Je vous remercie d'avance !

[patricktoulon]

bonjour
il manque des petites choses dans ton exposé du probleme

1. ou est la fonction transfert?
2. comment l'a tu coder (individuelle ou variable injectée)
3. il nous faut tout les codes qui doivent etre excutés si tu veux que l'on t aide

[Tekiila_67]

Ah oui pardon.

1/ Alors, la fonction transfert est dans mon classeur de macros personnelles. Tout comme toutes les macros que j'utilise dans la macro TRANSFERT_TOUT.

2/ Je ne suis pas assez bon pour répondre correctement à cette question apparemment, mais je vais faire de mon mieux.
Concernant le codage, il y a une partie qui a été réalisée grâce à l'enregistreur, et une autre que j'ai écrite moi même. Aucun "bug" n'est à déplorer dans cette partie là.

3/ Je peux en effet afficher tous les codes, mais ce sera EXTREMEMENT long ... J'ai réalisé la fonction transfert avec je crois 12 macros différentes qui permettent chacune une autre modification du fichier OT : Défusion cellules, Fusion cellules, Police code barre, concaténation, et ainsi de suite pour différentes petites choses afin de mieux cibler le problème si jamais j'en ai un. Il y a probablement moyen de faire mieux je l'accorde, mais en tant que débutant ça m'allait plus ou moins bien, surtout que ça fonctionne.

Pour info, le code

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
Sub TRANSFERT()
'
'
Sheets("OT à imprimer").Activate
Call Defusion
Call Fusion
Call Modifs1 'Ce dont je parlais avant, Code barre
Call Modifs2 'Concaténation
Call Modifs3 'etc etc...
Call Modifs4
Call Modifs5
Call Modifs6
Call Modifs7
Call Modifs8
Call Modifs9
Call Modifs10
Call Couleur  'Mise en couleur d'une plage de cellule en fonction d'un mot dans un autre onglet
Call Page      'Sert à modifier la valeur du nombre de page
Call Export_PDF 'Macro qui va enregistrer en PDF dans un répertoire bien précis
End Sub

Les programmes Défusion et Fusion ne font que de la selection de plages puis défusionnent puis refusionnent.
De même pour quasiment toutes les autres modifs : Selection de la plage à modifier, effectuer la modification, passer à la suite, voila comment j'ai rédigé mes macros.
Je ne fais appel à rien de particulier venant d'un autre fichier, tout se trouve dans mon classeur de macros personnelles.

Pour la macro Export_PDF, voici le code :

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
Sub Export_PDF()
'
'
'Macro écrite par Mike 
'Cette macro permet d'enregistrer l'onglet "OT à imprimer" au nombre de pages utiles dans un dossier précis
' avec demande d'écrasement si fichier déjà existant.
'
'
Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer
 
Application.ScreenUpdating = False
extension = ".pdf"
nomfichier = "OT_" & Sheets("FI_et_GT").Range("U1")
chemin = "C:\Users\.....Dossier essai OT\"
chemincomplet = chemin & nomfichier
FichierExiste = Dir(chemin & nomfichier & extension)
 
Call Page
 
    If FichierExiste <> "" Then
        If MsgBox("Attention, le fichier existe déjà, voulez-vous l'écraser ?", vbYesNo + vbExclamation, "Demande de confirmation") = vbYes Then
 
            If Sheets("OT à imprimer").Range("BC" & 259).Value = 1 Then
                 Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=9
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 228).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=8
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 197).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=7
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 166).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=6
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 135).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=5
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 104).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=4
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 73).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=3
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 42).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=2
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 11).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=1
            End If
 
            MsgBox "Dossier d'enregistrement :  " & chemin
 
 
        ElseIf vbNo Then
            MsgBox ("Veuillez mettre à jour la révision dans l'onglet FI_et_GT, cellule T1")
        End If
 
    Else
            If Sheets("OT à imprimer").Range("BC" & 259).Value = 1 Then
                 Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=9
 
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 228).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=8
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 197).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=7
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 166).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=6
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 135).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=5
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 104).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=4
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 73).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=3
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 42).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=2
 
            ElseIf Sheets("OT à imprimer").Range("BC" & 11).Value = 1 Then
                Sheets("OT à imprimer").ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & nomfichier, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False, IncludeDocProperties:=True, From:=1, To:=1
            End If
 
            MsgBox "Dossier d'enregistrement :  " & chemin
 
        End If
End Sub

Il y a surement un moyen plus simple d'écrire ce genre de code, mais pour faire simple, le fichier OT à imprimer fait 9 pages dans le modèle, et anciennement les utilisateurs imprimaient tout même si seulement une page était remplie. Ma macro permet donc de n'imprimer, ou plutôt d'enregistrer en PDF uniquement lorsque la page est "utile".

[patricktoulon]

Je ne fais appel à rien de particulier venant d'un autre fichier, tout se trouve dans mon classeur de macros personnelles.

c'est bien le probleme que je soupconne
et le fait qu'elle soit dans le personal renforce mes soupcons
il faut regarder la fonction transfert si dans son code si c'est les bon classeurs et feuilles et meme plages pris en compte

[unparia]

Bonjour

que la macro recherche tous les fichiers .xlsm dans un repertoire ET dans les dossiers et sous dossiers, et effectue la macro nommée TRANSFERT.

c'est là, qu'est ton problème
ta boucle dir ne parcourt actuellement que les fichiers d'un seul répertoire et non ceux des dossiers et sous-dossiers de ce répertoire.
Pour parcourir l'ensemble de tous les fichiers (répertoire + dossiers + sous-dossiers) il te faut agir avec Dir en récursivité.
Tu trouveras sur ce forum (dans la rubrique "contributions") plusieurs contributions, dont la mienne, pour parcourir l'ensemble des fichiers que tu veux parcourir.

[Tekiila_67]

c'est bien le probleme que je soupconne
et le fait qu'elle soit dans le personal renforce mes soupcons
il faut regarder la fonction transfert si dans son code si c'est les bon classeurs et feuilles et meme plages pris en compte

Je viens de vérifier, et je n'ai pas l'impression de trouver de problème à ce niveau là ...

En fait, anciennement, les utilisateurs du modèle Excel avait à remplir leurs cellules et le fichier mettait en place l'onglet "OT à imprimer" de façon autonome, c'est-à-dire faisait un copier/coller des informations des onglets précédents. Une fois ceci fait, l'opérateur appuyait sur un bouton qui a été crée à l'époque pour enregistrer ce fichier Excel. Moi je dois juste reprendre ce fichier et modifier l'onglet "OT à imprimer" avec les nouvelles modifications. C'est juste une transition en gros, car j'ai déjà modifié le modèle de base et les nouveaux fichiers sont déjà au top.

Tout ceci pour dire que les cellules et la mise en page n'ont pas changé, et les plages ont été vérifiées une à une. Les défusion et fusion n'ont rien changé non plus car le texte était uniquement dans la première case à chaque fois, et tout a été adapté correctement. Comme dit, tout fonctionne bien, et si je fais fichier par fichier ça fonctionne parfaitement, c'est juste que si déjà j'y suis, autant terminer la macro pour qu'elle le fasse automatiquement pour les 130 fichiers.

Bonjour

c'est là, qu'est ton problème
ta boucle dir ne parcourt actuellement que les fichiers d'un seul répertoire et non ceux des dossiers et sous-dossiers de ce répertoire.
Pour parcourir l'ensemble de tous les fichiers (répertoire + dossiers + sous-dossiers) il te faut agir avec Dir en récursivité.
Tu trouveras sur ce forum (dans la rubrique "contributions") plusieurs contributions, dont la mienne, pour parcourir l'ensemble des fichiers que tu veux parcourir.

Oui en effet, quelque chose ici doit clocher car le premier fichier fonctionne bien.

Le fait que je ne fait pas de recherche dans les dossiers et sous-dossiers mais uniquement dans le répertoire est volontaire. Comme dit, étant débutant, j'essaye d'avancer pas-à-pas : Dès qu'une étape fonctionne, je passe à la suivante. Ici je bloque déjà lorsque j'ai placé manuellement 3 fichiers dans le repertoire, donc je ne continue pas plus loin et je cherche à me débloquer de cette étape. Je sais pas si j'ai été clair en gros ...
Lorsque cette étape, c'est-à-dire les 3 fichiers dans le dossier que j'ai crée juste pour voir si la macro fonctionne bien, fonctionnera correctement, je continuerai mon travail pour que la macro cherche dans les dossiers et les sous-dossiers du répertoire.
Je vais lire tes contributions et faire des essais encore... Merci

Pour répondre à tous les deux, j'ai lu sur les forums que la fonction Dir s'incrémente lorsqu'à la fin on fait unFichier=Dir. Mais chez moi j'ai l'impression qu'il ne fait rien. Et lorsque je rajoute ou modifie des choses dans cette ligne, j'ai l'erreur d’exécution 5.

[patricktoulon]

il n'y a aucune raison que dir dans ton do/loop ne liste pas tes fichiers
je vais essayer d'etre plus clair
ta sub

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
Sub TRANSFERT_TOUT()
 
Dim repertoire As String
Dim unFichier As String
Dim wbook As Workbook
 
repertoire = "C:\Users\....\Dossier transfert XLSM\"    'Ceci est un dossier temporaire d'essai dans lequel j'ai inséré 3 fichiers .xlsm pour vérifier si tout marche bien.
unFichier = Dir(repertoire & "*.xlsm")
 
Do While unFichier <> ""
    Workbooks.Open repertoire & unFichier, Updateslinks = False
    Application.ScreenUpdating = False
    Call TRANSFERT ' TRANSFERT étant la macro pour modifier un fichier dans le nouveau format (macro dans le personal xlb)
'dans ta fonction ou sub transfert
'quel classeur 1 et 2 sont pris en compte 
'quelle feuille sont prises en compte  
' le fait que tu call transfert sans argument (que tu n'en ai pas prevu)me fait penser et j'en suis presque certain que ce n'est pas les bons elements cité ci dessus qui sont pris en compte                                                  
    Workbooks(unFichier).Close False
    unFichier = Dir                    
Loop
End Sub

et pour peu que tu es un (on error resume next) dans ton code ou un jump dans une condition(if) l'erreur est masquée et on peu toujour courir pour trouver la coquille

de plus dans ta sub transfert tu call d'autre sub et un paquet en plus

Code :

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

1
2
3
4
5
6
7
8
9
Sheets("OT à imprimer").Activate
Call Defusion
Call Fusion
Call Modifs1 'Ce dont je parlais avant, Code barre
Call Modifs2 'Concaténation
Call Modifs3 'etc etc...
Call Modifs4
Call Modifs5
etc....

ce sheets "OT à imprimer" il est dans quel classeur?
ces sub modif il est ou leur code ?