Modification et sauvegarde d'un classeur sans message de confirmation
Citation:
Bonjour à tous,
J'ai écrit une macro sous excel 2016 qui fonctionne sous excel 2016 (PC perso) mais qui a un comportement différent sous Excel 2010 (PC pro)
La macro est très simple, elle ouvre tous les fichiers .xls d'un répertoire, copie des données et écrit des données dans les fichiers lus.
J'utilise l'instruction workbook.Close True pour fermer le classeur en l'enregistrant.
Sous excel 2016, tout se passe bien
Sous excel 2010, le message "voulez-vous sauvegarder les modifications" apparait après traitement de chaque fichier.
J'ai essayé les option DisplayAlerts True/False sans succès
Voici le code ci dessous, merci pour votre aide,
Jnoel
Code:
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
|
Sub Macro2()
Dim CD As Workbook
Dim CA As String
Dim F As String
Dim CS As Workbook 'définit la classeur
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim offset As Double
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets("Synthèse") 'définit l'onglet destination OD
offset = 1
Set CD = ThisWorkbook 'définit le classeur destination CD
CA = "E:\JEROME\excel\fichiers_sources\" 'définit la chemin d'acces du dossier, il faut que ça finnisse par "\" (à adapter)
F = Dir(CA & "*.xlsx") 'définit le premier fichier F avec extension .xlsx ayant CA comme chemin d'accès (extension à adapter)
Do While F <> "" 'exécute tant qu'il existe des fichiers
Application.Workbooks.Open (CA & F) 'ouvre le fichier F
Set CS = ActiveWorkbook 'définit le classeur source CS
For Each O In CS.Worksheets 'boucle sur tous les onglets O du classeur source CS
DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O (colonne à adapter selon le cas)
O.Activate
'copie de la plage ("A2", "A" et dernière ligne de la feuille O dans la feuille OD)
O.Range("A3") = "TEST"
O.Range("A2", "A" & DL).Select
Selection.Copy Destination:=OD.Range("A" & offset)
'copie de la plage ("C2", "C" et dernière ligne de la feuille O dans la feuille OD)
O.Range("C2", "C" & DL).Select
Selection.Copy Destination:=OD.Range("C" & offset)
'copie de la plage ("D2", "D" et dernière ligne de la feuille O dans la feuille OD)
O.Range("D2", "D" & DL).Select
Selection.Copy Destination:=OD.Range("D" & offset)
'renvoie dans la colonne G le nom de l'onglet O
OD.Range("G" & offset, "G" & offset - 2 + DL).Value = O.Name
Debug.Print "i" & i
Debug.Print "offset" & offset
Debug.Print "DL" & DL
offset = offset + DL - 1
Next O 'prochain onglet de la boucle
CS.Close True 'ferme le classeur source en l'enregistrant
F = Dir 'définit le prochain fichier F ayant avec extension .xlsx ayant CA comme chemin d'accès (extension à adapter)
Loop 'boucle
End Sub |
