probleme de date pour ouvrir les fichiers

**marine9** · 26/11/2015, 14h34

Bonjour à tous,

J'ai des fichiers (toujours le même nom) dans des répertoires sous la forme JJ_MM_AA où je souhaite récupérer des cellules de ces fichiers pour mettre dans un fichier en fonction de dates que je demande par formulaire.
La date de départ est récupérée via le formulaire en A4 pour le jour, B4 pour le mois et C4 pour l'année.
A9=DATE(C4;B4;A4) C11=A9+1 et A6=TEXTE(A9;"jj")&CAR(95)&TEXTE(A9;"mm")&CAR(95)&TEXTE(A9;"aa")
A7=TEXTE(C11;"jj")&CAR(95)&TEXTE(C11;"mm")&CAR(95)&TEXTE(C11;"aa") et A10=DATE(C5;B5;A5)
le tout dans ma feuil1.

J'ai fait une macro pour tester si mon répertoire existe (toutes les dates n'existent pas) et si oui ouvrir les fichiers un par un et récupérer les données que je veux.

Ci-dessous le début de la macro :

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
Sub Macro1()
 
Dim MyPath As Variant
Dim A6 As String
Dim A7 As String
Dim A9 As Date
Dim C11 As Date
Dim A10 As Date
Dim i As Variant
 
MyPath = "C:\...\" & Sheets("feuil1").[A6] & ""
 
    If DIR(MyPath, vbDirectory) = "" Then
        MsgBox "Le répertoire n'existe pas"
 
        MkDir MyPath
 
         For i = A9 To A10
            Sheets("feuil1").Range("C11") = A9 + 1
 
            Next i
            A7 = A6
            Range("A6").Activate
            Else
 
 
        If A10 < A9 And A10 > Sheets("feuil1").Range("D10") Then
 
        MsgBox "Date incorrect"
 
        Else
 
        Range("A6").Activate
 
        If DIR(MyPath, vbDirectory) <> "" And Sheets("feuil1").Range("A6") < Sheets("Feuil1").Range("A10") Then
 
 
 
        Workbooks.Open Filename:="C:\...\" & Sheets("feuil1").[A6] & "\Monfichier.xls"
 
        Windows("Monfichier.xls").Sheets("1ère_feuille").Activate
 
 
        MsgBox "fichier monfichier ouvert"
 
Else
 
                MsgBox "fin d'essai"
                End If
            End If
 
         End If
End Sub

Le problème c'est que mon fichier ne s'ouvre pas avec A6+1

Merci de votre aide

Bonne journée

Marine

**parmi** · 26/11/2015, 16h45

Bonjour,

Tout d'abord, quand tu mets du code, utilise le bouton # pour le formater.

En A6, ta formule aurait pu être

Code :

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

=A4&"_"&B4&"_"&C4

Maintenant tu déclares des variables A6, A7,...
Ces variables ne sont pas des cellules (!)

Comme tu n'affectes aucune valeur à celles-ci, dans le cas suivant tu boucles de l'année 0 à l'année 0, A9 et A10 étant des variables Date

Code :

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

1
2
3
4
For i = A9 To A10
   Sheets("feuil1").Range("C11") = A9 + 1
 
Next i

Si tu veux boucler de la valeur de la cellule A9 à la valeur de A10, il faudrait écrire

Code :

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

1
2
3
4
For i = Range("A9") To range("A10")
   Sheets("feuil1").Range("C11") = A9 + 1  'ici je ne sais pas trop ce que tu veux faire...
 
Next i

**marine9** · 26/11/2015, 22h13

Bonsoir Parmi,

Merci pour ta réponse
=A4&"_"&B4&"_"&C4 ton code est super
Ce que je veux essayer de faire dans ma boucle, que je te remercie d'avoir corrigé en partie,c'est augmenter A6=A4&"_"&B4&"_"&C4 de 1 ce qui n'est pas possible comme cela. Alors j'essayais en mettant A9 + 1 (qui est en faite A6 + 1 mais au format =DATE(C4;B4;A4)) et me permet peut être de mettre C11 en A7 =TEXTE(C11;"jj")&CAR(95)&TEXTE(C11;"mm")&CAR(95)&TEXTE(C11;"aa") pour essayer de remplacer A6 par A7.
Je ne sais pas si je m'explique bien, pour ouvrir mes autres fichiers je dois boucler sur sur les répertoires qui sont sous la forme 02_05_15, 03_05_15 etc...
je dois donc essayer d'augmenter A6 chemin de mon fichier de 1
N’hésite pas à demander si je me suis mal expliquée.

A bientôt j'espère

Marine

**parmi** · 26/11/2015, 23h02

Regarde ce que fait ce code.
Les seules données nécessaire sont les 3 cellules de départ: A4, B4 et C4

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
Sub Test()
    Dim LaDate As Date
    Dim NomFichier As String
 
    'On formate la date récupérée de A4:C4
    LaDate = DateSerial(Range("C4"), Range("B4"), Range("A4"))
 
    'si on veut augmenter la date d'un jour
    LaDate = LaDate + 1
 
    'on transcrit cette date au format des fichiers
    NomFichier = Format(LaDate, "dd_mm_yyyy") & ".xls"
 
    MsgBox NomFichier
 
End Sub

**marine9** · 27/11/2015, 00h05

Merci beaucoup Parmi ça marche super bien je vais pouvoir essayé d'avancer dans mon projet mais j'ai du mal avec ma boucle

si je peux encore te demander pourquoi ça ne marche pas

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
Option Explicit
Sub Macro1()
 
Dim MyPath As Variant
Dim A9 As Date
Dim A10 As Date
Dim LaDate As Date
Dim NomRep As String
 
 
 
NomRep = Format(LaDate, "dd_mm_yy") & ""
 
 
MyPath = "F:\Pilotes\NomRep"
 
 
 
    If DIR(MyPath, vbDirectory) = "" Then
    'si le répertoire n'existe pas
        MsgBox "Le répertoire n'existe pas"
 
 
            Else
 
        For LaDate = DateSerial(Range("C4"), Range("B4"), Range("A4")) To Range("A10")
 
            LaDate = LaDate + 1
 
 
        If Sheets("feuil1").Range("A10") < Sheets("feuil1").Range("A9") And Sheets("feuil1").Range("A10") > Sheets("feuil1").Range("D10") Then
        'si la date fin demandée est inférieur à la date de départ et que la date de fin demandée est supérieur à la date du jour
        MsgBox "Date incorrect"
 
        Else
 
 
            If DIR(MyPath, vbDirectory) <> "" And LaDate < Sheets("Feuil1").Range("A10") Then
            ' si le répertoire existe et que la date du répertoire est inférieure à la date de fin demandée
 
 
            Workbooks.Open Filename:="F:\Pilotes\NomRep\TOTO.xls"
            'Ouvrir le fichier TOTO
            Windows("TOTO.xls").Sheets("General").Activate
            ' Activer la feuille général du fichier TOTO
 
            MsgBox "fichier TOTO ouvert"
 
            End If
        End If
 
        Next LaDate
    End If
End Sub

Je pense que je dois avoir une erreur dans ma boucle.Si c'est pas trop te demander.
D'avance merci pour ta réponse

Marine

**kiki29** · 27/11/2015, 02h29

Salut, Balise ton code

**parmi** · 27/11/2015, 03h14

Code :

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

1
2
3
4
5
6
7
Dim MyPath As Variant
Dim A9 As Date
Dim A10 As Date
Dim LaDate As Date
Dim NomRep As String

NomRep = Format(LaDate, "dd_mm_yy") & ""

Ici, la variable LaDate n'a pas reçu de valeur donc = 0

Tu dois lui donner une valeur avant d'appeler la ligne "NomRep = ..."

Dim A9 et A10 n'ont plus besoin d'être là...
Étudie ce que je t'ai donné comme bout de code. C'est basique...
Apprend la base: Tu mets des points d'arrêts (F9) sur certaines lignes, tu regardes en pas à pas (F8) la valeur de tes variables, tu utilises la fenêtre Espion (menu Affichage / fenêtre Espion), ...

S'il y a problème, reviens et explique

**marine9** · 27/11/2015, 03h15

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
Sub Macro1()
 
Dim MyPath As Variant
Dim A9 As Date
Dim A10 As Date
Dim LaDate As Date
Dim NomRep As String
 
 
 
NomRep = Format(LaDate, "dd_mm_yy") & ""
 
 
MyPath = "F:\Pilotes\NomRep"
 
    While Sheets("feuil1").Range("A10") < Sheets("feuil1").Range("A9")
 
    If DIR(MyPath, vbDirectory) = "" Then
    'si le répertoire n'existe pas
        MsgBox "Le répertoire n'existe pas"
 
 
            Else
 
        For LaDate = DateSerial(Range("C4"), Range("B4"), Range("A4")) To Range("A10")
 
            LaDate = LaDate + 1
 
 
        If Sheets("feuil1").Range("A10") < Sheets("feuil1").Range("A9") And Sheets("feuil1").Range("A10") > Sheets("feuil1").Range("D10") Then
        'si la date fin demandée est inférieur à la date de départ et que la date de fin demandée est supérieur à la date du jour
        MsgBox "Date incorrect"
 
        Else
 
 
            If DIR(MyPath, vbDirectory) <> "" And LaDate < Sheets("Feuil1").Range("A10") Then
            ' si le répertoire existe et que la date du répertoire est inférieure à la date de fin demandée
 
 
            Workbooks.Open Filename:="F:\Pilotes\NomRep\mobifil.xls"
            'Ouvrir le fichier mobifil
            Windows("mobifil.xls").Sheets("General").Activate
            ' Activer la feuille général du fichier mobifil
 
            MsgBox "fichier mobifil ouvert"
 
            End If
        End If
 
        Next LaDate
    End If
    Wend
End Sub

**parmi** · 27/11/2015, 03h22

Code :

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

1
2
3
4
Dim LaDate As Date
Dim NomRep As String
 
NomRep = Format(LaDate, "dd_mm_yy") & ""

Que vaut LaDate ici ? ..... 0
Tu ne lui donnes aucune valeur avant d'appeler cette ligne...

**marine9** · 27/11/2015, 15h21

Code :

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

1
2
3
4
5
If DIR([MyPath], vbDirectory) = " " Then
 
    MsgBox "le répertoire n'existe pas"
 
    Else

On ne peut pas tester si le répertoire existe ou est vide.

As tu une solution ?

Merci d'avance

probleme de date pour ouvrir les fichiers [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager