problème avec une boucle et des if

**marine9** · 28/11/2015, 13h38

Bonjour,

Je ne suis pas une pro en VBA et j'aurais besoin de votre aide. J'ai essayé de faire une boucle mais en mode débogage je ne rentre pas dans ma boucle comme il faudrait, je ne passe pas au fichier suivant et je ne copie pas mes cellules.
Je pense que je ne suis pas douée pour les boucles et les "if".

Merci d'avance de votre aide.

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
Sub test2()
 
 
Dim MyPath As Variant
Dim LaDatedeb As Date
Dim LaDatefin As Date
Dim NomRep As String
Dim LaDate As Date
Dim y As Variant
Dim JourS As Variant
 
LaDate = DateSerial(Range("C4"), Range("B4"), Range("A4"))
LaDatedeb = DateSerial(Range("C4"), Range("B4"), Range("A4"))
LaDatefin = DateSerial(Range("C5"), Range("B5"), Range("A5"))
JourS = Day(LaDate)
 
 
 
 
    NomRep = Format(LaDate, "dd_mm_yy") & ""
 
    MsgBox NomRep
 
    MyPath = "F:\Pilotes\" & [NomRep] & ""
    MsgBox MyPath
 
    'For LaDate = LaDatedeb To LaDatefin
    Do Until LaDatefin < LaDatedeb
 
        If Dir([MyPath], vbDirectory) = " " Then
 
        'si le répertoire n'existe pas
    MsgBox "Le répertoire n'existe pas"
    LaDate = LaDate + 1
    ChDir (MyPath)
     ' si le répertoire existe et que la date du répertoire est inférieure à la date de fin demandée
                'MsgBox MyPath
        Else
                Workbooks.Open Filename:="F:\Pilotes\" & [NomRep] & "\toto.xls"
                'Ouvrir le fichier toto
                Sheets("General").Activate
                ' Activer la feuille général du fichier mobifil
 
                MsgBox "fichier toto ouvert"
 
 
 
            'If LaDatefin < LaDatedeb And LaDatefin > Workbooks("monfichier.xlsm").Sheets("feuil1").Range("D10") Then
            'si la date fin demandée est inférieure à la date de départ et que la date de fin demandée est supérieure à la date du jour
            'MsgBox "Date incorrect"
 
             'If DIR([MyPath], vbDirectory) = " " Then
 
                ' si le répertoire existe et que la date du répertoire est inférieure à la date de fin demandée
                'MsgBox MyPath
 
 
                        If JourS = 1 Then 'lundi
 
                        'If Sheets("General").Cells(8, 3) = "7:00-7:15" Then
                        Range("C8:C39,C52:C67").Select
                        Selection.Copy
                        Windows("monfichier.xlsm").Activate
                        Sheets("LUNDI").Select
                        Range("C7").Select
                        ActiveSheet.Paste
                        Range("D12").Select
                        Windows("toto.xls").Activate
                        ActiveWindow.Close
 
 
                        Else
                            If JourS = 2 Then 'Mardi
                            Range("C8:C39,C52:C67").Select
                            Selection.Copy
                            Windows("monfichier.xlsm").Activate
                            Sheets("LUNDI").Select
                            Range("C7").Select
                            ActiveSheet.Paste
                            Range("D12").Select
                            Windows("toto.xls").Activate
                            ActiveWindow.Close
                            If Dir([MyPath], vbDirectory) = " " Then
                             Else
                                If JourS = 3 Then 'Mercredi
                                Range("C8:C39,C52:C67").Select
                                Selection.Copy
                                Windows("monfichier.xlsm").Activate
                                Sheets("LUNDI").Select
                                Range("C7").Select
                                ActiveSheet.Paste
                                Range("D12").Select
                                Windows("toto.xls").Activate
                                ActiveWindow.Close
 
                                Else
                                    If JourS = 4 Then 'Jeudi
                                    Range("C8:C39,C52:C67").Select
                                    Selection.Copy
                                    Windows("monfichier.xlsm").Activate
                                    Sheets("LUNDI").Select
                                    Range("C7").Select
                                    ActiveSheet.Paste
                                    Range("D12").Select
                                    Windows("toto.xls").Activate
                                    ActiveWindow.Close
 
                                    Else
                                        If JourS = 5 Then 'Vendredi
                                        Range("C8:C39,C52:C67").Select
                                        Selection.Copy
                                        Windows("monfichier.xlsm").Activate
                                        Sheets("LUNDI").Select
                                        Range("C7").Select
                                        ActiveSheet.Paste
                                        Range("D12").Select
                                        Windows("toto.xls").Activate
                                        ActiveWindow.Close
 
                                        Else
                                            If JourS = 6 Then 'Samedi
                                            Range("C8:C39,C52:C67").Select
                                            Selection.Copy
                                            Windows("monfichier.xlsm").Activate
                                            Sheets("LUNDI").Select
                                            Range("C7").Select
                                            ActiveSheet.Paste
                                            Range("D12").Select
                                            Windows("totol.xls").Activate
                                            ActiveWindow.Close
                                            End If
                                        End If
                                    End If
 
                                End If
 
                            End If
                        End If
                        End If
            Workbooks("toto.xls").Close
 
        End If
 
 
 
            LaDate = LaDate + 1
            ChDir (MyPath)
            MsgBox "fin d'essai"
    Loop
 
 
End Sub

Invité · 28/11/2015, 16h00

Bonjour,
Déjà tu peux virer tout les if concernant le jours!

Code :

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

1
2
MyJours=Array("Dimanche","Lundi","Mardi","Mercredi","Jeudi","Vendredi","Samedi")
Sheets(MyJours(JourS)).Select

Maintenant plus besoin de tester les jours de la semaine!

**Philippe Tulliez** · 28/11/2015, 16h13

Bonjour,
Il existe aussi la fonction VBA qui renvoie une chaîne de caractères du nom du jour

Code :

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

MsgBox WeekdayName(1)

renverra Lundi

Invité · 28/11/2015, 17h11

Bonsoir Philippe ,
Personnellement je n'aime pas cette fonction car elle tient compte des paramètres régionaux!

**SfJ5Rpw8** · 28/11/2015, 17h29

Envoyé par rdurupt

Bonsoir Philippe ,
Personnellement je n'aime pas cette fonction car elle tient compte des paramètres régionaux!

Bonjour,

c'est pas forcément ... un problème au contraire ... tout d'abords il faudra corriger l'erreur de marine9 sur la ligne 15 :

Code :

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

JourS = Day(LaDate)

qui doit provoquer un plantage de ton code..

ensuite il suffit d'utiliser WeekDayName avec les bons paramètres ... pas besoin de tableaux...

**marine9** · 28/11/2015, 18h35

Rebonjour,

merci à vous tous grâce à vous j'ai corrigé mon code comme ça et ça marche

Code :

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

JourS = Weekday(LaDate, vbMonday)

maintenant je n'ai plus que la fermeture du fichier qui plante j'ai encore du faire une erreur

Code :

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

Workbooks("toto.xls").Close

me met erreur d’exécution '9' l'indice n'appartient pas à la sélection.

si vous pouvez encore m'aider

Invité · 28/11/2015, 19h45

Code :

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

1
2
3
4
set wb=Workbooks.Open (Filename:="F:\Pilotes\" & [NomRep] & "\toto.xls")
Wb.close
'ou
Workbooks (Filename:="F:\Pilotes\" & [NomRep] & "\toto.xls").close

**marine9** · 28/11/2015, 22h43

MERCI RDURUPT

Grace à toi j'ai nettement progressé mon programme tourne enfin je n'ai plus qu'à trouvé comment copier mes semaines suivantes je regarde maintenant la fonction offset (je débute en BVA) de façon à copier mes colonnes à la suite.
Si tu as du temps pour m'aider je suis preneuse sinon bonne soirée et merci à tout ceux qui m'ont aidé en espérant ne pas être obligé de mettre un nouveau post parce que je n'y arrive pas.

Marine

c'est en persévérant qu'on apprend.

Invité · 28/11/2015, 23h47

Code :

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

1
2
3
 
DerL=Windows("monfichier.xlsm").Sheets("LUNDI").cells(cells.rows.count,"c").end(xlup).row +1
Range("C8:C39,C52:C67").Copy Windows("monfichier.xlsm").Sheets("LUNDI").cells(DerL,"c")

**marine9** · 29/11/2015, 00h42

Rebonsoir,

Code :

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

DerL = Windows("monfichier.xlsm").Sheets("LUNDI").Cells(Cells.Rows.Count, "c").End(xlUp).Row + 1

ça met "erreur d'exécution 438 propriété ou méthode non gérée par cet objet"

merci quand même.

Marine

Invité · 29/11/2015, 01h01

teste comme ça

Code :

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

derL = ThisWorkbook.Sheets("LUNDI").Cells(Cells.Rows.Count, "c").End(xlUp).Row + 1

**marine9** · 29/11/2015, 03h12

Bonsoir RDURUPT,

Tout d'abord merci encore de m'avoir consacré du temps grâce à toi et au forum je progresse régulièrement en VBA.
Maintenant j'ai un autre souci je n'arrive pas à sortir de la boucle. Le programme continue à chercher les répertoires suivant même après la date de fin. As tu une proposition à me faire pour changer mon code ? si cela ne t'embête pas de trop et ne te gêne pas pendant ton weekend.
Merci encore
A bientôt

Marine

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
Do Until LaDatefin = LaDatedeb
        NomRep = Format(LaDate, "dd_mm_yy") & ""
 
 
    MyPath = "F:\Pilotes\" & [NomRep] & ""
    MsgBox MyPath
 
        If Dir([MyPath], vbDirectory) = " " Then
 
        'si le répertoire n'existe pas
    MsgBox "Le répertoire n'existe pas"
    LaDate = LaDate + 1 
Else
                Workbooks.Open Filename:="F:\Pilotes\" & [NomRep] & "\
    MsgBox NomRep

Invité · 29/11/2015, 12h02

Bonjour,
Ça arrivé souvent que la date de fin soit plus petit que la date de début?

Et à quoi sert ladate=ladate +1

Ce que je rencontre souvent c'est ladate comprise entre deb et fin!

**marine9** · 29/11/2015, 18h30

Bonjour,

Ok merci

Bonne fin de week end

Invité · 29/11/2015, 23h41

Bonsoir,

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
 
LaDate=LaDatedeb
Do while  LaDatedeb<=LaDate and LaDate<=LaDatefin
        NomRep = Format(LaDate, "dd_mm_yy") & ""
 
 
    MyPath = "F:\Pilotes\" & [NomRep] & ""
    MsgBox MyPath
 
        If Dir([MyPath], vbDirectory) = " " Then
 
        'si le répertoire n'existe pas
    MsgBox "Le répertoire n'existe pas"
    Else
                Workbooks.Open Filename:="F:\Pilotes\" & [NomRep] & "\"
    MsgBox NomRep
End if
LaDate = LaDate + 1 
Loop

**marine9** · 30/11/2015, 07h12

Bonjour,

Merci encore de répondre à mes questions.
J'ai encore un souci mon code ci dessous ne vérifie pas que le répertoire n'existe pas il essaie d'ouvrir le fichier même si le répertoire n'existe pas et donc met un message d'erreur vous avez du déplacer le fichier.
Serait ce abuser que de te demander si tu as une idée pour la correction.
Merci d'avance et bonne journée

Code :

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

If Dir([MyPath], vbDirectory) = " " Then

Invité · 30/11/2015, 08h04

Bonjour

Code :

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

If Dir([MyPath], vbDirectory) = "" Then

**marine9** · 30/11/2015, 23h25

Bonsoir,

J'espère que tu as passé une bonne journée.
Ca y est j'ai résolu le problème je ne l'avais pas mis comme il faut dans ma boucle
Tu vois quand j'ai mis problème avec une boucle et des if j'avais raison lol.
Je progresse je progresse.
Je te redis si j'ai un autre problème bonne journée pour demain je pense que tu es déjà couché, je devrais faire la même je me lève tôt demain matin
A+

problème avec une boucle et des if [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager