Bonjour,

Dans la macro suivante, en toute fin du code, je demande à l'opérateur s'il veut sauvegarder le fichier xlsm.
Le problème c'est que par défaut le dossier "C:\Backup_ndt_Test" n'existe pas. La macro me retourne donc une erreur.
Des suggestions ? Merci par avance.

Cdlt.
Jérôme

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Sub Recup_donnees_pour_TDB()
 
'Déclaration des variables
Dim nbr As Integer
Dim Derlig As Integer
Dim x As String
Dim y As Integer
Dim i As Integer
Dim Program As String
Dim PO As String
Dim PO_Date As Date
Dim Content As String
Dim Deliv_Target_Date As Date
Dim Deliv_Date_OTD1 As Date
Dim Deliv_Time_OTD1 As String
Dim Last_Reject_Date As Date
Dim Deliv_Date_OTD2 As Date
Dim Deliv_Time_OTD2 As String
Dim Quality_OQD As Integer
Dim Quality_NC_Iteration As String
Dim Global_note As Single
Dim Deliv_Note_Test As Date
Dim Deliv_Note_A As Date
Dim Good_Receipt As Date
Dim Status As String
Dim Comments As String
Dim Chemin As String
Dim Fichier As String
 
'Exécution de la macro "Recuperation_Noms_sous_dossiers"
Call Recuperation_Noms_sous_dossiers
 
'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False
 
nbr = 0
 
'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> derlig
'Recherche du nombre de références ID en colonne B --> nbr
Derlig = Application.WorksheetFunction.CountA(Range("B:B")) + 3
nbr = Range("B6:B" & Derlig).SpecialCells(xlCellTypeVisible).Count
 
'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr & " ID's references")
 
'Initialisation des compteurs (on part de la ligne 6)
i = 1
y = 6
 
'Boucle sur le nombre de références ID, nbr (remplissage du tableau)
While i <= nbr
 
'Activation du fichier "FOLLOW_UP_TEST.xlsm", on active l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
'x correspond à la valeur de la cellule B6 (première valeur de la liste)
x = Range("B" & y).Value
 
'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate
 
'Mise en mémoire des données du fichier "Entry_Form_ID.....xlsm". Celles-ci sont à rapatrier dans le fichier "FOLLOW_UP_TEST.xlsm"
Program = Range("C7").Value
PO = Range("C8").Value
PO_Date = Range("C9").Value
Content = Range("C10").Value
Deliv_Target_Date = Range("H6").Value
Deliv_Date_OTD1 = Range("H8").Value
Deliv_Time_OTD1 = Range("H9").Value
Last_Reject_Date = Range("H11").Value
Deliv_Date_OTD2 = Range("H13").Value
Deliv_Time_OTD2 = Range("H14").Value
Quality_OQD = Range("N8").Value
Quality_NC_Iteration = Range("M10").Value
Global_note = Range("M12").Value
Deliv_Note_Test = Range("F21").Value
Deliv_Note_A = Range("F22").Value
Good_Receipt = Range("E30").Value
Status = Range("E31").Value
Comments = Range("E32").Value
 
'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
'On colle les valeurs précédemment mises en mémoire dans le fichier "FOLLOW_UP_TEST.xlsm" (onglet "Feuil1")
Range("C" & y).Value = Program
Range("D" & y).Value = PO
Range("E" & y).Value = PO_Date
Range("F" & y).Value = Content
Range("G" & y).Value = Deliv_Target_Date
Range("I" & y).Value = Deliv_Date_OTD1
Range("J" & y).Value = Deliv_Time_OTD1
Range("L" & y).Value = Quality_OQD
Range("M" & y).Value = Last_Reject_Date
Range("N" & y).Value = Deliv_Date_OTD2
Range("P" & y).Value = Deliv_Time_OTD2
Range("Q" & y).Value = Quality_NC_Iteration
Range("R" & y).Value = Deliv_Note_Test
Range("S" & y).Value = Deliv_Note_A
Range("T" & y).Value = Good_Receipt
Range("U" & y).Value = Status
Range("V" & y).Value = Comments
Range("W" & y).Value = Global_note
 
y = y + 1
i = i + 1
 
'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False
 
Wend
 
'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
 
Range("A1").Select
 
MsgBox ("Update finished")
 
Application.EnableEvents = True
 
'Possibilité de sauvegarder le fichier "FOLLOW_UP_TEST.xlsm" sur le disque local avec intégration de la date et de l'heure dans le nom du fichier.
If MsgBox("Do you want to save the file 'FOLLOW_UP_TEST.xlsm' to your local disk ?", vbYesNo, "Confirmation Request") = vbNo Then
Exit Sub
Else
Chemin = InputBox("Select the folder where you want to save the file", "Backup Folder", "C:\Backup_NDT_TEST\")
'Ajoute la date du jour et l'heure dans le nom du fichier
Fichier = "FOLLOW_UP_TEST_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
End If
 
End Sub