Deuxieme boucle Do While qui ne s'execute pas

**clickandgo** · 28/11/2015, 21h26

Bonjour à tous

Comme dit dans le titre la deuxième boucle ("Boucle remplissage des cellules") sensée remplir cellule par cellule une valeur de champ ne s’exécute pas dans la fonction suivante tandis que la première créé bien les étiquettes et leur nommage . Même le compteur J ne renvoie aucune valeur ...

Merci de m'aiguiller

Voici le code :

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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
Option Compare Database
Option Explicit
 
Public Function CreerEtiquettesPlanning()
 
Dim Hauteur As Integer
Dim Largeur As Integer
Dim NouvellePosition As Integer
Dim Espacement As Integer
Dim NbLignes As Integer
Dim DateDuJour As Date
Dim DernierJourMois As Date
Dim rstTableHoraire As DAO.Recordset
Dim ColHoraires, ColLundi, ColMardi, ColMercredi, ColJeudi, ColVendredi, ColSamedi, ColDimanche As Control
Dim LargeurChampsHoraires, LargeurMargeHoraires As Integer
Dim rstRendezVous As DAO.Recordset
Dim CréneauActif As Field
 
 
 
Dim i, j As Integer
 
 
Set rstTableHoraire = CurrentDb.OpenRecordset("t_horaires_intervenants")
Set rstRendezVous = CurrentDb.OpenRecordset("rq_rendez_vous_jour")
 
Hauteur = 600
LargeurMargeHoraires = 600
LargeurChampsHoraires = 2000
Espacement = 100
 
DernierJourMois = DateSerial(Year(Date), Month(Date) + 1, 0)
 
'Effacer tous les contrôles créés précédement
 
DoCmd.OpenForm "essai etiquettes", acDesign, , , , acHidden
 
 
    While Forms![essai etiquettes].Controls.Count > 0
        DeleteControl "essai etiquettes", Forms![essai etiquettes].Controls(0).Name
    Wend
 
    DoCmd.Close acForm, "essai etiquettes", acSaveYes 'on ferme le formulaire
 
'Création des nouvelles etiquettes des créneaux
 
DoCmd.OpenForm ("essai etiquettes"), acDesign, , , , acHidden
 
 
'Boucle pour la création des Etiquettes de créneaux verticales pour chaque jour
 
    Do While Not rstTableHoraire.EOF
 
        i = i + 1
 
        Set ColHoraires = CreateControl("Essai etiquettes", acLabel, acDetail)
        Set ColLundi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColMardi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColMercredi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColJeudi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColVendredi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColSamedi = CreateControl("essai etiquettes", acTextBox, acDetail)
        Set ColDimanche = CreateControl("essai etiquettes", acTextBox, acDetail)
 
        With ColHoraires
 
 
            .Name = "Horaire " & i
            .Left = Espacement
            .Top = 10 + (Hauteur * i)
            .Width = LargeurMargeHoraires
            .Height = Hauteur
            .Caption = Format(rstTableHoraire!heure, "h:mm")
            .TextAlign = 3
 
 
        End With
 
        With ColLundi
 
            .Name = "Créneau Lundi " & i
            .Left = LargeurMargeHoraires + Espacement
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
            .BackColor = RGB(255, 255, 224)
            .TextAlign = 2
            .TextFormat = 1
 
        End With
 
        With ColMardi
 
            .Name = "Créneau Mardi " & i
            .Left = LargeurChampsHoraires + LargeurMargeHoraires + Espacement
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
        .BackColor = RGB(255, 255, 224)
         .TextAlign = 2
            .TextFormat = 1
 
        End With
 
        With ColMercredi
 
            .Name = "Créneau Mercredi " & i
            .Left = LargeurChampsHoraires * 2 + LargeurMargeHoraires + Espacement + 10
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
        .BackColor = RGB(255, 255, 224)
         .TextAlign = 2
            .TextFormat = 1
 
        End With
 
        With ColJeudi
 
            .Name = "Créneau Jeudi " & i
            .Left = LargeurChampsHoraires * 3 + LargeurMargeHoraires + Espacement + 10
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
            .BackColor = RGB(255, 255, 224)
            .TextAlign = 2
            .TextFormat = 1
 
        End With
 
        With ColVendredi
 
            .Name = "Créneau Vendredi " & i
            .Left = LargeurChampsHoraires * 4 + LargeurMargeHoraires + Espacement + 10
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
            .BackColor = RGB(255, 255, 224)
            .TextAlign = 2
            .TextFormat = 1
        End With
 
        With ColSamedi
 
            .Name = "Créneau Samedi " & i
            .Left = LargeurChampsHoraires * 5 + LargeurMargeHoraires + Espacement + 10
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
            .BackColor = RGB(255, 255, 224)
            .TextAlign = 2
            .TextFormat = 1
 
        End With
 
        With ColDimanche
 
            .Name = "Créneau Dimanche " & i
            .Left = LargeurChampsHoraires * 6 + LargeurMargeHoraires + Espacement + 10
            .Top = 10 + (Hauteur * i)
            .Width = LargeurChampsHoraires
            .Height = Hauteur
            .BackColor = RGB(224, 255, 255)
            .TextAlign = 2
            .TextFormat = 1
 
        End With
 
 
    rstTableHoraire.MoveNext
    Loop
 
 
    DoCmd.OpenForm ("essai etiquettes")
 
 
    'Boucle Remplissage des cellules
 
    Do While Not rstTableHoraire.EOF
 
        j = j + 1
 
      CréneauActif = "Créneau Lundi " & j
      Debug.Print j
 
      Forms("essai etiquettes")!['"& CréneauActif &'"] = "oui"
 
     rstTableHoraire.MoveNext
     Loop
 
 
   DoCmd.Save acForm, "essai etiquettes"
 
Set rstTableHoraire = Nothing
Set rstRendezVous = Nothing
 
End Function

**nico84** · 30/11/2015, 12h16

Bonjour,

Il manque un movefirst avant d'attaquer la 2e boucle

**clickandgo** · 30/11/2015, 15h15

Merci Nico mais cela ne change rien... D'ailleurs si je mets un movefirst aussi dans la première boucle une erreur apparaît au moment de la création des étiquettes alors que sans tout va bien.

Je continue donc à avoir la deuxième boucle qui ne s'éxécute pas

Merci d'avance pour toute aide

**nico84** · 30/11/2015, 16h20

Ah ben si forcément quand il arrive à la 2e boucle rstTableHoraire.EOF est vrai donc il va direct à la suite

**clickandgo** · 01/12/2015, 14h37

Bonjour Nico

Finalement j'ai opté pour faire 2 fonctions séparées ce qui offre une plus grande facilité de lecture.
D'autre part je m'étais trompé dans la déclaration de la variable CréneauActif en tant que "field", en la déclarant en tant que "control" tout est rentré dans l'ordre et la boucle s'est exécutée normalement.

Pendant que j'y suis et si tu as le temps pourrais tu regarder mon récent post concernant les fonctions imbriquées ? , personne n'y répond ...

Merci pour tout

Deuxieme boucle Do While qui ne s'execute pas

VBA Access

Discussions similaires

Partager

Partager