Discussion :

[sweetking]

J'ai une table de donnée alimentée quotidiennement. J'ai un modèle de table identique dans laquelle je ne veux garder que les données des 7 derniers jours.
La macro se trouve dans un fichier intermédiaire qui ne sert qu'à générer le fichier d'extrait.

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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 
Sub Creer()
 
  ' Déclarations
  Dim fs As Object
  Dim strCheminFicSource As String
  Dim strCheminTemplate As String
  Dim strCheminDossierCible As String
  Dim strTemplateNomFichierCible As String
  Dim strNomFichierCible As String
  Dim strCheminFichierCible As String
  Dim objApplicationExcel As Excel.Application
  Dim objFichierSource As Excel.Workbook
  Dim objFeuilleALire As Excel.Worksheet
  Dim objFichierCible As Excel.Workbook
  Dim objFeuilleARemplir As Excel.Worksheet
  Dim lngNumLigneSource As Long
  Dim oldStatusBar As Variant
  Dim c As Long
 
 
  ' Récupération des chemins d'accès
 
  strCheminFicSource = Cells(2, 2).Value
  strCheminTemplate = Cells(3, 2).Value
  strCheminDossierCible = Cells(4, 2).Value
  strTemplateNomFichierCible = Cells(5, 2).Value
 
 
  ' Création d'un objet de type "File System" pour pouvoir utiliser des fonctions de gestion des fichiers
  Set fs = CreateObject("Scripting.FileSystemObject")
 
 
  ' Test de validité des paramètres
  If fs.FileExists(strCheminFicSource) And fs.FileExists(strCheminTemplate) _
    And (Not Dir(strCheminDossierCible, vbDirectory) = vbNullString) And strTemplateNomFichierCible <> "" Then
 
 
    ' Ouverture et lecture du fichier source
    Set objApplicationExcel = CreateObject("Excel.Application")
    Set objFichierSource = objApplicationExcel.Workbooks.Open(strCheminFicSource)
    ' On sélectionne la première feuille
    Set objFeuilleALire = objFichierSource.Worksheets(1)
 
    ' On commence à lire à partir de la sixième ligne car les 5 premières contient l'en-tête
    lngNumLigneSource = 6
 
    ' Sauvegarde du contenu de la barre de statut
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
 
      ' Création du fichier quotidien
 
      strNomFichierCible = Replace(strTemplateNomFichierCible, "xxxx", Date)
 
      ' Chemin du fichier à créer
      strCheminFichierCible = strCheminDossierCible & "\" & strNomFichierCible
 
      ' Gestion des messages de progression
      Application.StatusBar = "Création du fichier " & strCheminFichierCible
 
 
 
      ' Test d'existence du fichier à créer
      If fs.FileExists(strCheminFichierCible) Then
 
        MsgBox "Il existe déjà un fichier " & strNomFichierCible
 
      Else
 
        ' Ouverture et lecture du fichier modèle
        Set objApplicationExcel = CreateObject("Excel.Application")
        Set objFichierCible = objApplicationExcel.Workbooks.Open(strCheminTemplate)
        ' On sélectionne la première feuille
        Set objFeuilleARemplir = objFichierCible.Worksheets(1)
 
        ' On commencera à écrire dans la 6 ème ligne du fichier de destination
        c = 6
 
             While objFeuilleALire.Cells(lngNumLigneSource, 2).Value <> "" And lngNumLigneSource < 10000
 
                If lngNumLigneSource > Date - 7 Then
                     ' Alimentation du fichier cible
                    ' Workshop:
                    objFeuilleARemplir.Cells(c, 1) = objFeuilleALire.Cells(lngNumLigneSource, 1)
                    ' Batch No.
                    objFeuilleARemplir.Cells(c, 2) = objFeuilleALire.Cells(lngNumLigneSource, 2)
                    ' VIN No.
                    objFeuilleARemplir.Cells(c, 3) = objFeuilleALire.Cells(lngNumLigneSource, 3)
                    ' VPD:
                    objFeuilleARemplir.Cells(c, 4) = objFeuilleALire.Cells(lngNumLigneSource, 4)
                    ' Ford Part No.
                    objFeuilleARemplir.Cells(c, 5) = objFeuilleALire.Cells(lngNumLigneSource, 5)
                    ' CC_Code:
                    objFeuilleARemplir.Cells(c, 6) = objFeuilleALire.Cells(lngNumLigneSource, 6)
                    ' CC_Text:
                    objFeuilleARemplir.Cells(c, 7) = objFeuilleALire.Cells(lngNumLigneSource, 7)
                    ' CCC_Code:
                    objFeuilleARemplir.Cells(c, 8) = objFeuilleALire.Cells(lngNumLigneSource, 8)
                    ' CCC_Text:
                    objFeuilleARemplir.Cells(c, 9) = objFeuilleALire.Cells(lngNumLigneSource, 9)
                    ' Technical Comments:
                    objFeuilleARemplir.Cells(c, 10) = objFeuilleALire.Cells(lngNumLigneSource, 10)
                    ' Customer Comments:
                    objFeuilleARemplir.Cells(c, 11) = objFeuilleALire.Cells(lngNumLigneSource, 11)
                    ' Dealer:
                    objFeuilleARemplir.Cells(c, 12) = objFeuilleALire.Cells(lngNumLigneSource, 12)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 13) = objFeuilleALire.Cells(lngNumLigneSource, 13)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 14) = objFeuilleALire.Cells(lngNumLigneSource, 14)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 15) = objFeuilleALire.Cells(lngNumLigneSource, 15)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 16) = objFeuilleALire.Cells(lngNumLigneSource, 16)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 17) = objFeuilleALire.Cells(lngNumLigneSource, 17)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 18) = objFeuilleALire.Cells(lngNumLigneSource, 18)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 19) = objFeuilleALire.Cells(lngNumLigneSource, 19)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 20) = objFeuilleALire.Cells(lngNumLigneSource, 20)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 21) = objFeuilleALire.Cells(lngNumLigneSource, 21)
                    ' Engine Type  :
                    objFeuilleARemplir.Cells(c, 22) = objFeuilleALire.Cells(lngNumLigneSource, 22)
 
 
 
                    ' Incrémentation du numéro de ligne de destination
                    c = c + 1
                    ' On passe à la ligne suivante du fichier source
                    lngNumLigneSource = lngNumLigneSource + 1
 
                    Else
                    ' On passe à la ligne suivante du fichier source
                    lngNumLigneSource = lngNumLigneSource + 1
                End If
 
               Wend
 
 
       End If
 
        ' Sauvegarde et fermeture du fichier
        objFichierCible.SaveAs (strCheminFichierCible)
        objFichierCible.Close
 
 
 
 
 
 
    ' Désactivation des messages de progression
    Application.StatusBar = False
    Application.DisplayStatusBar = oldStatusBar
 
    ' Fermeture du fichier source
    objFichierSource.Close
 
  Else
 
    MsgBox "Erreur dans les paramètres saisis"
 
  End If
 
 
End Sub

J'avoue ne pas comprendre d'où vient cette erreur.

Merci d'avance pour votre aide

[Marc-L]

Bonjour, bonjour,

quand cela concerne le VBA, cela se passe dans le sous-forum Macros et VBA Excel
où il y a plus de chances d'obtenir de réponses que dans le forum de formules de feuille de calcul ! …

Sinon pour trouver la source d'une erreur, suivre la progression du code via le mode pas à pas (touche F8)
et vérifier les valeurs dans la fenêtre des Variables locales …

Je ne comprends vraiment pas les solutions retenues dans le code,
hormis FSO (VBA disposant en interne de tout le nécessaire),
pourquoi alourdir en utilisant une autre instance d'Excel ?

Tellement plus simple via un filtre par exemple (comme ici) …

Bon courage !

[sweetking]

Mes excuses pour l'erreur de rubrique. Si un modérateur peut corriger mon erreur je l'en remercie par avance.

Le but de cette macro est de non pas filtrer les données dans une feuille, mais d'extraire uniquement une partie des données dans un autre fichier qui sera lui rendu public.

l'analyse pas à pas me donne l'erreur suivante :

Erreur d'exécution '1004': Erreur définie par l'application ou par l'objet

sur la ligne 147 objFichierCible.SaveAs (strCheminFichierCible)

[Philippe Tulliez]

Bonjour,
Pour exporter des données suivants conditions, comme Marc te la signaler, tu peux le faire avec les outils natifs d'excel comme par exemple Les filtres élaborés transposable en VBA avec pas plus de 5 lignes de code (déclaration des tables comprises).
Voir tutoriel sur le sujet Les filtres avancés ou élaborés dans Excel