Discussion :

[akim_59330]

Bonjour,

Je suis débutant sur VBA, je viens de créer un programme car je voudrais compiler dans un fichier des informations de plusieurs fichiers.
Mon fichier qui compile les informations va ouvrir les fichiers excel qui sont dans le même répertoire et recopier les valeurs si le fichier commence par Wave.

La macro ouvre les fichiers et va enregistrer dans des variables des cellules ensuite elle les copie dans mon fichier recap.

Le code fonctionne mais la macro est trop longue, elle mouline pendant beaucoup de temps.
De plus je souhaite copier davantage de cellule mais j'ai peur que le programme ne soit encore plus long.

Y-a-t-il un moyen pour améliorer le code? Est-on obliger d'ouvrir le fichier pour collecter des données? Y-a-til un autre moyen que stocker chaque cellule dans des variables indépendantes?

Merci pour votre aide.

Voici mon premier code, soyez indulgent :

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
 
Sub ListingFichiers()
 
Dim Rep As String, Fichier As String
Dim i As Integer
Dim file_ongoing As String
Dim path_ongoing As String
Dim nom As String
Dim numero As String
Dim montantHT As Double
Dim montantTTC As Double
Dim datef As Date
 
 
 
Application.ScreenUpdating = False  'utiliser pour am?liorer la vitesse de la macro
Application.Calculation = xlCalculationManual 'utiliser pour am?liorer la vitesse de la macro
 
'suppression de l'ancien historique
Sheets("Feuil2").Select
Range("A1").CurrentRegion.Select
Selection.ClearContents
 
'cr?ation de l'historique
Sheets("Feuil1").Select
Range("A1").CurrentRegion.Select
Selection.Copy
Sheets("Feuil2").Select
Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'suppression de l'ancien export
Sheets("Feuil1").Select
Range("A1").CurrentRegion.Select
Selection.ClearContents
 
 
'définition des titres du tabeau
Range("A1") = "Nom du fichier"
Range("B1") = "Type de document"
Range("C1") = "Num?ro"
Range("D1") = "Date de cr?ation"
Range("E1") = "Montant HT (?)"
Range("F1") = "Montant TTC (?)"
Range("G1") = "Commentaire 1"
Range("H1") = "Commentaire 2"
 
file_ongoing = ThisWorkbook.Name 'on r?cup?re le nom du fichier r?cap
path_ongoing = ThisWorkbook.Path 'on r?cup?re le chemin sur le r?seau o? se trouve le fichier
 
Rep = path_ongoing & "\" 'avec la fonction ThisWorkbook.path il manque un \ donc on l'ajoute
 
Fichier = Dir(Rep)
 
Do While Fichier <> "" 'boucle dans le r?pertoire
    If Fichier <> file_ongoing And Left(Fichier, 4) Like "Wave" Then
        i = i + 1
          Sheets("Feuil1").Range("A" & i + 1) = Fichier
            Workbooks.Open(Rep & Fichier).Activate  'ouverture d'un fichier comprenant le nom "wave"
            ActiveSheet.Unprotect "wave"            'mot de passe du fichier verrouill?
              nom = Sheets("Feuil1").Range("nom")   ' r?cup?ration de pluiseurs info dans diff?rentes variables
              numero = Sheets("Feuil1").Range("numero")
              datef = Sheets("Feuil1").Range("date")
              montantHT = Sheets("Feuil1").Range("montantHT")
              montantTTC = Sheets("Feuil1").Range("montantTTC")
            ActiveSheet.Protect "wave"
            ActiveWorkbook.Close SaveChanges:=False  'fermeture du fichier
 
            Sheets("Feuil1").Range("B" & i + 1) = nom   'copie des variables
            Sheets("Feuil1").Range("C" & i + 1) = numero
            Sheets("Feuil1").Range("D" & i + 1) = datef
            Sheets("Feuil1").Range("E" & i + 1) = montantHT
            Sheets("Feuil1").Range("F" & i + 1) = montantTTC
    End If
    Fichier = Dir  'fichier suivant
Loop
 
 
    Range("A1:H" & i + 1).Select 'mise en forme du tableau
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$" & i + 1), , xlYes).Name = _
        "Tableau4"
    ActiveSheet.ListObjects("Tableau4").TableStyle = "TableStyleLight2"
    Columns("A:F").EntireColumn.AutoFit
 
 
Range("K1") = i
 
End Sub

[Invité]

Bonjour,

Regardez si ce code améliore le temps de traitement :

• La déprotection et reprotection vous fait perdre un temps non négligeable. Sur un essai de 2 fichiers, le temps de traitement est de 0,9 secondes sans modifier la protection et 1.3 avec.
• La mise à jour sans passer par des variables devrait vous faire gagner du temps.

Nb : Lorsque vous postez du code, sélectionnez le et cliquez sur la balise # dans le menu. Il n'est pas trop tard pour faire cette modification sur votre premier message.

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
 
Option Explicit
 
Sub ListingFichiers_EK()
 
Dim WbHisto As Workbook, WbWave As Workbook
Dim ShHisto1 As Worksheet, ShHisto2 As Worksheet, ShWave As Worksheet
Dim LigneHisto1 As Long
 
Dim Rep As String, Fichier As String, File_OnGoing As String, Path_OnGoing As String
Dim HeureDebut2, HeureFin2, TempsTotal2
 
 
        HeureDebut2 = Timer
 
        On Error GoTo Fin
 
        Set WbHisto = ActiveWorkbook
        With WbHisto
 
             Set ShHisto1 = .Sheets("Feuil1")
             Set ShHisto2 = .Sheets("Feuil2")
 
             File_OnGoing = .Name 'on récupère le nom du fichier r?cap
             Path_OnGoing = .Path 'on récupère le chemin sur le r?seau o? se trouve le fichier
             Rep = Path_OnGoing & "\" 'avec la fonction ThisWorkbook.path il manque un \ donc on l'ajoute
 
        End With
 
        'suppression de l'ancien historique
        ShHisto2.Range("A1").CurrentRegion.ClearContents
 
        'création de l'historique
        ShHisto1.Range("A1").CurrentRegion.Copy
        ShHisto2.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        With ShHisto1
 
             'suppression de l'ancien import
             If .ListObjects.Count > 0 Then .ListObjects(1).Delete
             .Range("A1").CurrentRegion.ClearContents
             'définition des titres du tabeau
             .Range("A1:H1") = Array("Nom du fichier", "Type de document", "Numéro", "Date de création", "Montant HT (?)", "Montant TTC (?)", "Commentaire 1", "Commentaire 2")
             LigneHisto1 = 2
        End With
 
 
        Application.ScreenUpdating = False 'utiliser pour am?liorer la vitesse de la macro
        Application.Calculation = xlCalculationManual 'utiliser pour am?liorer la vitesse de la macro
 
 
        Fichier = Dir(Rep)
 
        Do While Fichier <> "" 'boucle dans le r?pertoire
 
            If Fichier <> File_OnGoing And Left(Fichier, 4) Like "Wave" Then
 
               ShHisto1.Cells(LigneHisto1, "A") = Fichier
 
               Set WbWave = Workbooks.Open(Rep & Fichier) 'ouverture d'un fichier comprenant le nom "wave"
               Set ShWave = WbWave.Sheets(1)
               With ShWave
                    '.Unprotect "wave" 'mot de passe du fichier verrouill?
                     ShHisto1.Cells(LigneHisto1, "B") = .Range("nom").Value
                     ShHisto1.Cells(LigneHisto1, "C") = .Range("numero").Value
                     ShHisto1.Cells(LigneHisto1, "D") = .Range("date").Value
                     ShHisto1.Cells(LigneHisto1, "E") = .Range("montantHT").Value
                     ShHisto1.Cells(LigneHisto1, "F") = .Range("montantTTC").Value
                    '.Protect "wave"
                End With
                WbWave.Close savechanges:=False
                Set ShWave = Nothing: Set WbWave = Nothing
 
                LigneHisto1 = LigneHisto1 + 1
            End If
            Fichier = Dir 'fichier suivant
 
        Loop
 
        If LigneHisto1 > 2 Then
            With ShHisto1
                 'mise en forme du tableau
                 LigneHisto1 = .Cells(.Rows.Count, 1).End(xlUp).Row
                 .ListObjects.Add(xlSrcRange, .Range("$A$1:$H$" & LigneHisto1), , xlYes).Name = "Tableau4"
                 .ListObjects("Tableau4").TableStyle = "TableStyleLight2"
                 .Columns("A:F").EntireColumn.AutoFit
                 .Range("K1") = LigneHisto1
            End With
        End If
 
 
        HeureFin2 = Timer
        TempsTotal2 = HeureFin2 - HeureDebut2
 
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
 
        MsgBox "Temps total du traitement : " & Round(TempsTotal2, 1) & " seconde(s)", vbInformation, "Import des données Wave"
 
        GoTo Fin
 
 
Fin:
 
       Application.ScreenUpdating = True
       Application.Calculation = xlCalculationAutomatic
 
       Set WbHisto = Nothing: Set WbWave = Nothing
       Set ShHisto1 = Nothing: Set ShHisto2 = Nothing: Set ShWave = Nothing
 
 
End Sub

[akim_59330]

Bonjour Erik,

Merci pour votre aide.

En effet les commandes unprotect ralentissait la macro pour aucun bénéfice.
Ton programme est beaucoup plus élégant, je m'en servirai pour ce projet et d'autres.

Si je supprime les lignes unprotect de mon pg de base il prend le même temps d'excution que votre programme (environ 2 s par fichier).

Je trouve que c'est raisonnable, je vais tout de même utiliser ton code si tu me le permets :-).

Je cherche à récupérer le nom de l'utilisateur qui a enregistré la facture qui sera chargé. Connais tu une ligne de code magique?

[Invité]

Bonjour,

Si le nom de l'utilisateur est noté dans les propriétés des fichiers, alors regarde ce tuto de Silky Road : https://silkyroad.developpez.com/VBA...asseurs/#LII-A

Dans ton cas, ce serait :

Code :

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

1
2
3
4
 
  WbWave.BuiltinDocumentProperties ("Author")
' ou
  WbWave.BuiltinDocumentProperties ("Last author")

[akim_59330]

Merci Eric pour vos retours.
Akim