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
Partager