Accélérer un code

Version imprimable

Accélérer un code

Bonjour

Voilà, j'ai un code qui me permet de remplir des plannings. Il fonctionne mais je le trouve lent à l’exécution.

Je vais avoir 4 sortes de plannings différents à remplir (hebdomadaire, bimensuel, tri mensuel et mensuel) 'exemple çi dessous correspond au bimensuel

Les données qui changerons par semaine pour la conception sont le S(N°) de la fin

Le planning est conçu de tel manière :

Tout les jours de la semaine,
Heure d'arrivée le matin (M1)
Heure de départ le matin(M2)
Heure d'arrivée l'après midi (S1)
Heure de départ l'après midi (S2)
Numéro de semaine S(N°)

J1M1S1 = cela correspond pour moi à Jour1(Lundi); Matin1(heure d'arrivée le matin) Semaine1(Première semaine)

Si quelqu'un à une idée pour améliorer et accélérer ce code je suis preneur.

Merci d'avance.

Code:

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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
Private Sub Valider_PlanningBimensuel_Click()
Application.DisplayAlerts = False
'----------------------Matin SEMAINE 1----------------
 
If Planning.J1M1S1 = "" Then
ActiveCell.Value = ""
Else: ActiveCell.Value = CDate(Planning.J1M1S1)
End If
    If Planning.J2M1S1 = "" Then
    ActiveCell.Offset(1, 0) = ""
    Else: ActiveCell.Offset(1, 0) = CDate(Planning.J2M1S1)
    End If
        If Planning.J3M1S1 = "" Then
        ActiveCell.Offset(2, 0) = ""
        Else: ActiveCell.Offset(2, 0) = CDate(Planning.J3M1S1)
        End If
            If Planning.J4M1S1 = "" Then
            ActiveCell.Offset(3, 0) = ""
            Else: ActiveCell.Offset(3, 0) = CDate(Planning.J4M1S1)
            End If
                If Planning.J5M1S1 = "" Then
                ActiveCell.Offset(4, 0) = ""
                Else: ActiveCell.Offset(4, 0) = CDate(Planning.J5M1S1)
                End If
                    If Planning.J6M1S1 = "" Then
                    ActiveCell.Offset(5, 0) = ""
                    Else: ActiveCell.Offset(5, 0) = CDate(Planning.J6M1S1)
                    End If
                        If Planning.J7M1S1 = "" Then
                        ActiveCell.Offset(6, 0) = ""
                        Else: ActiveCell.Offset(6, 0) = CDate(Planning.J7M1S1)
                        End If
If Planning.J1M2S1 = "" Then
ActiveCell.Offset(0, 1) = ""
Else: ActiveCell.Offset(0, 1) = CDate(Planning.J1M2S1)
End If
    If Planning.J2M2S1 = "" Then
    ActiveCell.Offset(1, 1) = ""
    Else: ActiveCell.Offset(1, 1) = CDate(Planning.J2M2S1)
    End If
        If Planning.J3M2S1 = "" Then
        ActiveCell.Offset(2, 1) = ""
        Else: ActiveCell.Offset(2, 1) = CDate(Planning.J3M2S1)
        End If
            If Planning.J4M2S1 = "" Then
            ActiveCell.Offset(3, 1) = ""
            Else: ActiveCell.Offset(3, 1) = CDate(Planning.J4M2S1)
            End If
                If Planning.J5M2S1 = "" Then
                ActiveCell.Offset(4, 1) = ""
                Else: ActiveCell.Offset(4, 1) = CDate(Planning.J5M2S1)
                End If
                    If Planning.J6M2S1 = "" Then
                    ActiveCell.Offset(5, 1) = ""
                    Else: ActiveCell.Offset(5, 1) = CDate(Planning.J6M2S1)
                    End If
                        If Planning.J7M2S1 = "" Then
                        ActiveCell.Offset(6, 1) = ""
                        Else: ActiveCell.Offset(6, 1) = CDate(Planning.J7M2S1)
                        End If
 
'----------------------Soir SEMAINE 1----------------
If Planning.J1S1S1 = "" Then
ActiveCell.Offset(0, 2) = ""
Else: ActiveCell.Offset(0, 2) = CDate(Planning.J1S1S1)
End If
    If Planning.J2S1S1 = "" Then
    ActiveCell.Offset(1, 2) = ""
    Else: ActiveCell.Offset(1, 2) = CDate(Planning.J2S1S1)
    End If
        If Planning.J3S1S1 = "" Then
        ActiveCell.Offset(2, 2) = ""
        Else: ActiveCell.Offset(2, 2) = CDate(Planning.J3S1S1)
        End If
            If Planning.J4S1S1 = "" Then
            ActiveCell.Offset(3, 2) = ""
            Else: ActiveCell.Offset(3, 2) = CDate(Planning.J4S1S1)
            End If
                If Planning.J5S1S1 = "" Then
                ActiveCell.Offset(4, 2) = ""
                Else: ActiveCell.Offset(4, 2) = CDate(Planning.J5S1S1)
                End If
                    If Planning.J6S1S1 = "" Then
                    ActiveCell.Offset(5, 2) = ""
                    Else: ActiveCell.Offset(5, 2) = CDate(Planning.J6S1S1)
                    End If
                        If Planning.J7S1S1 = "" Then
                        ActiveCell.Offset(2, 2) = ""
                        Else: ActiveCell.Offset(6, 2) = CDate(Planning.J7S1S1)
                        End If
If Planning.J1S2S1 = "" Then
ActiveCell.Offset(0, 3) = ""
Else: ActiveCell.Offset(0, 3) = CDate(Planning.J1S2S1)
End If
    If Planning.J2S2S1 = "" Then
    ActiveCell.Offset(1, 3) = ""
    Else: ActiveCell.Offset(1, 3) = CDate(Planning.J2S2S1)
    End If
        If Planning.J3S2S1 = "" Then
        ActiveCell.Offset(2, 3) = ""
        Else: ActiveCell.Offset(2, 3) = CDate(Planning.J3S2S1)
        End If
            If Planning.J4S2S1 = "" Then
            ActiveCell.Offset(3, 3) = ""
            Else: ActiveCell.Offset(3, 3) = CDate(Planning.J4S2S1)
            End If
                If Planning.J5S2S1 = "" Then
                ActiveCell.Offset(4, 3) = ""
                Else: ActiveCell.Offset(4, 3) = CDate(Planning.J5S2S1)
                End If
                    If Planning.J6S2S1 = "" Then
                    ActiveCell.Offset(5, 3) = ""
                    Else: ActiveCell.Offset(5, 3) = CDate(Planning.J6S2S1)
                    End If
                        If Planning.J7S2S1 = "" Then
                        ActiveCell.Offset(6, 3) = ""
                        Else: ActiveCell.Offset(6, 3) = CDate(Planning.J7S2S1)
                        End If
'----------------------Matin SEMAINE 2----------------
 
If Planning.J1M1S2 = "" Then
ActiveCell.Offset(9, 0) = ""
Else: ActiveCell.Offset(9, 0) = CDate(Planning.J1M1S2)
End If
    If Planning.J2M1S2 = "" Then
    ActiveCell.Offset(10, 0) = ""
    Else: ActiveCell.Offset(10, 0) = CDate(Planning.J2M1S2)
    End If
        If Planning.J3M1S2 = "" Then
        ActiveCell.Offset(11, 0) = ""
        Else: ActiveCell.Offset(11, 0) = CDate(Planning.J3M1S2)
        End If
            If Planning.J4M1S2 = "" Then
            ActiveCell.Offset(12, 0) = ""
            Else: ActiveCell.Offset(12, 0) = CDate(Planning.J4M1S2)
            End If
                If Planning.J5M1S2 = "" Then
                ActiveCell.Offset(13, 0) = ""
                Else: ActiveCell.Offset(13, 0) = CDate(Planning.J5M1S2)
                End If
                    If Planning.J6M1S2 = "" Then
                    ActiveCell.Offset(14, 0) = ""
                    Else: ActiveCell.Offset(14, 0) = CDate(Planning.J6M1S2)
                    End If
                        If Planning.J7M1S2 = "" Then
                        ActiveCell.Offset(15, 0) = ""
                        Else: ActiveCell.Offset(15, 0) = CDate(Planning.J7M1S2)
                        End If
If Planning.J1M2S2 = "" Then
ActiveCell.Offset(9, 1) = ""
Else: ActiveCell.Offset(9, 1) = CDate(Planning.J1M2S2)
End If
    If Planning.J2M2S2 = "" Then
    ActiveCell.Offset(10, 1) = ""
    Else: ActiveCell.Offset(10, 1) = CDate(Planning.J2M2S2)
    End If
        If Planning.J3M2S2 = "" Then
        ActiveCell.Offset(11, 1) = ""
        Else: ActiveCell.Offset(11, 1) = CDate(Planning.J3M2S2)
        End If
            If Planning.J4M2S2 = "" Then
            ActiveCell.Offset(12, 1) = ""
            Else: ActiveCell.Offset(12, 1) = CDate(Planning.J4M2S2)
            End If
                If Planning.J5M2S2 = "" Then
                ActiveCell.Offset(13, 1) = ""
                Else: ActiveCell.Offset(13, 1) = CDate(Planning.J5M2S2)
                End If
                    If Planning.J6M2S2 = "" Then
                    ActiveCell.Offset(14, 1) = ""
                    Else: ActiveCell.Offset(14, 1) = CDate(Planning.J6M2S2)
                    End If
                        If Planning.J7M2S2 = "" Then
                        ActiveCell.Offset(15, 1) = ""
                        Else: ActiveCell.Offset(15, 1) = CDate(Planning.J7M2S2)
                        End If
 
'---------------------- Soir SEMAINE 2 ----------------
If Planning.J1S1S2 = "" Then
ActiveCell.Offset(9, 2) = ""
Else: ActiveCell.Offset(9, 2) = CDate(Planning.J1S1S2)
End If
    If Planning.J2S1S2 = "" Then
    ActiveCell.Offset(10, 2) = ""
    Else: ActiveCell.Offset(10, 2) = CDate(Planning.J2S1S2)
    End If
        If Planning.J3S1S2 = "" Then
        ActiveCell.Offset(11, 2) = ""
        Else: ActiveCell.Offset(11, 2) = CDate(Planning.J3S1S2)
        End If
            If Planning.J4S1S2 = "" Then
            ActiveCell.Offset(12, 2) = ""
            Else: ActiveCell.Offset(12, 2) = CDate(Planning.J4S1S2)
            End If
                If Planning.J5S1S2 = "" Then
                ActiveCell.Offset(13, 2) = ""
                Else: ActiveCell.Offset(13, 2) = CDate(Planning.J5S1S2)
                End If
                    If Planning.J6S1S2 = "" Then
                    ActiveCell.Offset(14, 2) = ""
                    Else: ActiveCell.Offset(14, 2) = CDate(Planning.J6S1S2)
                    End If
                        If Planning.J7S1S2 = "" Then
                        ActiveCell.Offset(15, 2) = ""
                        Else: ActiveCell.Offset(15, 2) = CDate(Planning.J7S1S2)
                        End If
If Planning.J1S2S2 = "" Then
ActiveCell.Offset(9, 3) = ""
Else: ActiveCell.Offset(9, 3) = CDate(Planning.J1S2S2)
End If
    If Planning.J2S2S2 = "" Then
    ActiveCell.Offset(10, 3) = ""
    Else: ActiveCell.Offset(10, 3) = CDate(Planning.J2S2S2)
    End If
        If Planning.J3S2S2 = "" Then
        ActiveCell.Offset(11, 3) = ""
        Else: ActiveCell.Offset(11, 3) = CDate(Planning.J3S2S2)
        End If
            If Planning.J4S2S2 = "" Then
            ActiveCell.Offset(12, 3) = ""
            Else: ActiveCell.Offset(12, 3) = CDate(Planning.J4S2S2)
            End If
                If Planning.J5S2S2 = "" Then
                ActiveCell.Offset(13, 3) = ""
                Else: ActiveCell.Offset(13, 3) = CDate(Planning.J5S2S2)
                End If
                    If Planning.J6S2S2 = "" Then
                    ActiveCell.Offset(14, 3) = ""
                    Else: ActiveCell.Offset(14, 3) = CDate(Planning.J6S2S2)
                    End If
                        If Planning.J7S2S2 = "" Then
                        ActiveCell.Offset(15, 3) = ""
                        Else: ActiveCell.Offset(15, 3) = CDate(Planning.J7S2S2)
                        End If
MsgBox "Le nouveau Planning à bien été créé !"
 
Application.DisplayAlerts = True
' --------------------Rempli la feuille New Collegue -------------
New_Collegue.Fr_ChoixPlanning.Visible = True
New_Collegue.CB_ChoixPlanning = Planning.CB_PlanningBimensuel
 
End
End Sub

06/08/2018, 15h21
a_diard

Bonjour
Je ne comprends pas :
Planning.J1M1S1

Je pense que écrire tes valeurs dans une variable tableau
puis d'écrire le tableau dans la feuille en une seule fois

de permettrait d'accélérer ton code.
07/08/2018, 13h59
ziisman
Bonjour,

Je sais pas si ça sera la meilleure méthode mais moi j'utilise :
Code:

1 2 Application.ScreenUpdating = False ' en début de code Application.ScreenUpdating = True ' en fin de code
En général ça fait gagner un peu de temps sur l'exécution des macros, mais c'est pas d'un efficacité folle non plus :mrgreen:
07/08/2018, 15h24
Pierre Fauconnier

Salut.

Dis-nous ce que tu souhaites réaliser (Pas en pseudo vba, mais comme si tu ne savais pas coder, style cahier des charges simplifié). Ce sera plus facile pour t'aider. Des IF ElseIF imbriqués à ce point, c'est rarement une bonne idée, voire jamais ;)
08/08/2018, 10h19
Didpa

2 pièce(s) jointe(s)

Bonjour

Merci, de vous intéresser au problème.

J'ai une feuille Planning qui comportera :
10 plannings hebdomadaires
10 Plannings Bimensuels
10 Plannings Trimensuels
5 Plannings Mensuels

Cette feuilles comportant quelques formules.... J'aimerais que les utilisateurs y est le moins accès possible.

Pièce jointe 402416

C'est plannings seront remplis via un USF

Pièce jointe 402419

Donc :

Sélectionner le n° de planning choisi via la combobox de Planning_1 à Planning_35
Dans l'onglet Hebdomadaire, la combobox me permet de choisir seulement un numéro de planning hebdomadaire (de 1 à 10), comme cela dans chaque onglet je peux choisir seulement les plannings de l'onglet correspondant.

option 1 : Le planning est déjà existant -> Je valide
option 2 : Je rempli un planning vide (hebdo, mensuel, bimensuel..etc) selon le cas de la personne.

Quand je navigue entre les plannings :
Il vérifie sil est vide ou non
Si vide messagebox "Voulez vous créer un nouveaux planning ? vbyesNo
Je remplis les Textbox puis je valide.
Si textbox = "" (vide), ce n'est pas grave, (nous ne sommes non plus obligé de travailler tous les jours :D)
Déjà existant, il affiche les horaires.

Quand je passe d'un planning existant à un planning vide via la combobox, je vide les textbox afin d'avoir un planning vierge.

Voilà j'espère avoir été clair, pas toujours facile d'exprimer ses idées par écrit. Si ce n'est pas le cas je vous pris de m'en excuser :roll:

Cordialement
08/08/2018, 10h27
sogedic
Bonjour
Evite tout les activecell.offset(,,) : chaque acces a excel est long
le mieux c'est d'utiliser une table puis de mettre les données de la table dans le plannbing
Code:

1 2 3 4 5 6 7 8 9 10 11 dim tabP1 as variant redim tabP1(1 to nblg, 1 to nbcol) 'traitement tabP1(lg,col) = "xx" 'Resultat with activesheet .range(.cells(1,1),.cells(nblg,nbcol))=tabP1 end with
08/08/2018, 10h48
Didpa
Merci Sogedic.
Code:

1 2 3 4 5 6 7 8 9 10 dim tabP1 as variant redim tabP1(1 to nblg, 1 to nbcol) 'traitement tabP1(lg,col) = "xx" 'Resultat with activesheet .range(.cells(1,1),.cells(nblg,nbcol))=tabP1 end with
Donc je vais essayer de comprendre ton code car j'aimerais être aussi performant que certains dans ce forum, mais ce n'est pas le cas. :(

1 je nomme chaque Planning

ensuite je bloque sur ton code, si ce n'est pas trop demandé peux tu me l'expliquer ligne par ligne SVP, afin que je puisse le comprendre et l'utiliser.

Cordialement.

Bonjour

C'est que se serait mieux avec des commentaires .. que voici

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
'Pour chaque planning, déclarer un tableau  
dim tabP1 as variant, tabP2 as variant …
'Redimensionner ces tableaux en fonction des plannings
redim tabP1(1 to nb de ligne du planning 1, 1 to nombre de colonne du planning 1)
redim tabP2(1 to nb de ligne du planning 2, 1 to nombre de colonne du planning 2)
 
'Traitement : ne plus accéder a maintes reprises à la feuille excel
'remplacer planning1.cells(1,1).offset(1,2) par tabP1(1+1,1+2) 
 
'Fin : completer chaque planning avec sa table de valeur
with activesheet
   .range(.cells(1ere ligne du planning 1,1ere colonne du planning 1),.cells(derniere ligne du planning 1,derniere colonne du planning 1))=tabP1
   .range(.cells(1ere ligne du planning 2,1ere colonne du planning 2),.cells(derniere ligne du planning 2,derniere colonne du planning 2))=tabP2
 
end with

j'espère que c'est un peu plus clair

Bonjour

j'essai de comprendre et d'appliquer ton code, (Je suis allé voir dans dans : Utiliser les variables tableaux, mais cela reste encore floue pour moi)

Donc :

Code:

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
Private Sub CB_TEST_Click()
'Pour chaque planning, déclarer un tableau
Dim tabP1 As Variant
tabP1 = Range("B110:E116").Value
'Redimensionner ces tableaux en fonction des plannings
'redim tabP1(1 to nb de ligne du planning 1, 1 to nombre de colonne du planning 1)
'redim tabP2(1 to nb de ligne du planning 2, 1 to nombre de colonne du planning 2)

ReDim tabP1(1 To 7, 1 To 4)
 
'Traitement : ne plus accéder a maintes reprises à la feuille excel
'remplacer planning1.cells(1,1).offset(1,2) par tabP1(1+1,1+2)
tabP1(0 + 0) = CDate(Planning.J1M1)
tabP1(0 + 1) = CDate(Planning.J1M2)
tabP1(0 + 2) = CDate(Planning.J1S1)
tabP1(0 + 3) = CDate(Planning.J1S2)
'Fin : completer chaque planning avec sa table de valeur
'Resultat
With ActiveSheet
   '.range(.cells(1ere ligne du planning 1,1ere colonne du planning 1),.cells(derniere ligne du planning 1,derniere colonne du planning 1))=tabP1
   '.range(.cells(1ere ligne du planning 2,1ere colonne du planning 2),.cells(derniere ligne du planning 2,derniere colonne du planning 2))=tabP2
 
   .Range(.Cells(1, 1), .Cells(7, 4)) = tabP1
End With

End Sub

En rouge j'ai comme erreur l'indice n'appartient pas à la sélection. j'essai de comprendre, merci encore pour votre aide.

09/08/2018, 10h30
a_diard

Bonjour

https://silkyroad.developpez.com/vba/tableaux/

Je ne sais pas si tu as lu ceci.

Je pense que ça répond à tes questions.

et répond à ta demande " Accélérer un code"

quand tu fais : tabP1 = Range("B110:E116").Value

le premier élément est 1 et pas 0

Code:

tabP1(0 + 0)

je pense que du devrais mettre :

Code:

tabP1(1,1)
09/08/2018, 10h38
Didpa

Bonjour

Effectivement je les bien lu, même tester, mais je suis trop novice pour pouvoir l'adapter à mon code, mais j'essaie de comprendre le fonctionnement afin de pouvoir le faire.
Cordialement
09/08/2018, 10h43
Pierre Fauconnier

Salut.

Dans le code que tu donnes au message #9, tu as la ligne ReDim tabP1(1 To 7, 1 To 4) qui dit explicitement que le premier indice de ton tableau sera 1. Quelques lignes plus bas, tu as tabP1(0 + 0) = CDate(Planning.J1M1) qui montre que tu essaies d'utiliser l'indice 0 du tableau :aie:

Perso, je ne comprends pas bien l'utilisation des REDIM sur les tableaux. Je ne suis d'ailleurs pas persuadé qu'il faille passer par des tableaux. Transformer des plages en Array est utile pour du traitement sur des plages très importantes ou pour charger des combobox ou listbox, mais sur des plages aussi réduites que celles de ton planning, c'est se compliquer la vie pour rien, à mon avis.

En outre, chaque planning ayant son propre format (et donc chaque onglet de userform ayant le sien), il me semblerait judicieux de créer autant de procédures qu'il y a de types de plannings. Ce serait plus facile à gérer.

L'échange de données entre un tableau d'une feuille et un userform n'est pas quelque chose de complexe à la base et là, j'ai l'impression d'un code bien complexe pour un va-et-vient de données assez simple, en fait.

Cela étant dit, je ne comprends pas trop l'utilité de passer par du VBA, surtout vu ta configuration. Si tu souhaites que les utilisateurs ne touchent pas à tes formules, pourquoi ne pas simplement les verrouiller? Chacun pourrait accéder à la zone modifiable du planning pou y noter les infos. Passer par du vba et un userform va te contraindre à vérifier la saisie pour t'assurer qu'on a saisi une valeur horaire valide, par exemple…

Pour finir, ta conception mélange les données et leur présentation (un des sept péchés capitaux d'Excel). Puisqu'utilisation de VBA, j'aurais mieux vu une architecture de type base de données: un seul tableau pour toutes les données d'un type de planning, un userform pour saisir les infos, et UN planning visuel pour afficher les données (à des fins d'impression, par exemple) qui serait valorisé par formules ou par VBA. (s'inspirer éventuellement de mon tuto sur la création d'un planning mensuel perpétuel).

3 pièce(s) jointe(s)

Voici une solution qui évite de passer par des tableaux pour les plannings. Le seul tableau qui est utilisé sert à alimenter la combobox. Le découpage en petites procédures/fonctions permet d'adapter plus facilement le code proposé à ta situation.

Le principe de base s'applique ici à un seul type de planning, mais c'est le même principe pour chaque type de planning. Afin d'éviter de mouliner pour rien, il convient de ne charger que le planning sur lequel on travaille. Autrement dit, on ne charge pas les plannings pour tous les onglets. Avec cette technique, ça ne saurait pas être lent et l'utilisation de tableaux pour lire ou modifier les cellules d'un planning ne se justifie pas. Je n'ai illustré ici que la récupération d'un planning hebdo, mais il suffit de créer la fonction pour retrouver la cellule du début des autres plannings pour adapter.

Comme toujours, il faut d'abord établir la liste de ce que l'on doit faire:

on a besoin de la liste des plannings disponibles pour alimenter la combobox (getPlanningNames);
on a besoin de se positionner sur le planning choisi dans la combo (getPlanningNameCell);
Par un offset et un resize, on détermine la plage des données du planning choisi;
on nomme les textbox avec les indices qui correspondent aux positions des cellules dans la plage du planning (lundi matin début = 11, 1ière ligne, 1ière colonne, jeudi après midi fin = 44 (4ième ligne, 4ième colonne) pour pouvoir travailler avec une boucle;
on a besoin de convertir les heures en texte à la lecture;
on a besoin de convertir les textes en heures à l'écriture;
idéalement, on teste que la saisie dans un textbox est pertinente, et donc qu'elle correspond à une valeur horaire (non documenté ici).

Sur base de la disposition suivante des plannings et du userform illustré contenant cboPlannings (combobox avec la liste des plannings) et 28 textbox appelés tboRC ou R est le numéro de ligne et C le numéro de colonne, pour correspondre aux positions dans la plage du planning.

Pièce jointe 402755

Pièce jointe 402756

Dans un module standard:
Etablir la liste des plannings: getPlanningNames(). j'utilise un tableau avec Redim pour l'exemple. Cette fonction renvoie un array de base 0 contenant la liste des plannings. L'offset(11) correspond à l'écart en lignes entre deux plannings. Cet array permettra d'alimenter rapidement la combobox de choix du planning
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Function getPlanningNames() Dim t ReDim t(0) Dim Counter As Long Dim rng As Range Set rng = Range("a4") Counter = 0 t(0) = rng.Value Set rng = rng.Offset(11) Do While rng.Value <> "" Counter = Counter + 1 ReDim Preserve t(Counter) t(Counter) = rng.Value Set rng = rng.Offset(11) Loop getPlanningNames = t End Function
On a besoin de trouver la cellule sup gauche d'un planning: getPlanningNameCell. La fonction utilise Match pour simplifier la recherche sur les cellules fusionnées
Code:

1 2 3 4 5 6 Function getPlanningNameCell(Name As String) As Range Dim r r = Application.Match(Name, Range("a:a"), 0) If Not IsError(r) Then Set getPlanningNameCell = Range("a" & r) End Function
On a besoin d'ouvrir le userform et d'alimenter la combobox
Code:

1 2 3 4 5 6 7 8 9 10 Sub Planning() Dim Plannings Plannings = getPlanningNames() Unload usfPlanning With usfPlanning .cboPlanning.List = Plannings .Show End With End Sub
Toujours dans un module standard, on a besoin de charger le planning après sélection dans la combo. On utilisera une fonction qui reçoit le nom du planning
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Function ReadPlanning(Name As String) As Long Dim DataRange As Range Dim PlanningNameCell As Range Dim r As Long, c As Long On Error GoTo EndHandler Set PlanningNameCell = getPlanningNameCell(Name) If Not PlanningNameCell Is Nothing Then Set DataRange = PlanningNameCell(3, 2).Resize(7, 4) With usfPlanning For r = 1 To 7 For c = 1 To 4 .Controls("tbo" & r & c).Value = Format(DataRange(r, c).Value, "hh:mm") Next c Next r End With ReadPlanning = -1 End If EndHandler: If Err.Number <> 0 Then ReadPlanning = Err.Number End Function
Egalement dans le module standard, on a besoin de la fonction qui écrira les données des textbox dans la plage du planning. C'est en gros la même que pour la lecture, mais dans l'autre sens
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Function SavePlanning(Name As String) As Long Dim DataRange As Range Dim PlanningNameCell As Range Dim r As Long, c As Long Set PlanningNameCell = getPlanningNameCell(Name) If Not PlanningNameCell Is Nothing Then Set DataRange = PlanningNameCell(3, 2).Resize(7, 4) With usfPlanning For r = 1 To 7 For c = 1 To 4 DataRange(r, c).Value = CDate(.Controls("tbo" & r & c).Value) Next c Next r End With SavePlanning = -1 End If EndHandler: If Err.Number <> 0 Then SavePlanning = Err.Number End Function
Le code du userform est simplissime; Il devrait normalement être complété par une fonction de vérification de la saisie.
Code:

1 2 3 4 5 6 7 Private Sub btnValidate_Click() SavePlanning cboPlanning.Value End Sub Private Sub cboPlanning_Change() ReadPlanning cboPlanning.Value End Sub
On pourrait gagner une ou deux millisecondes en mémorisant la plage du planning entre la lecture et l'écriture…

Je ne vois pas une technique qui permettrait d'être plus rapide. Modulaire, elle peut servir d'ossature à l'utilisation d'un userform plus complexe comme le tien, en considérant bien le fait que chaque planning n'est chargé que si besoin, on ne charge donc pas chaque onglet dès le départ) ;)

Bonjour

Merci encore à vous, cela va faire plusieurs années que vous m'enlevez une épines du pieds. :P

J'ai téléchargé votre fichier et j'ai un message d'erreur (ligne rouge) :Incompatibilité de Type. ?????

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Function SavePlanning(Name As String) As Long
  Dim DataRange As Range
  Dim PlanningNameCell As Range
  Dim r As Long, c As Long
  
  Set PlanningNameCell = getPlanningNameCell(Name)
  If Not PlanningNameCell Is Nothing Then
    Set DataRange = PlanningNameCell(3, 2).Resize(7, 4)
    With usfPlanning
      For r = 1 To 7
        For c = 1 To 4
          DataRange(r, c).Value = CDate(.Controls("tbo" & r & c).Value)
        Next c
      Next r
    End With
    SavePlanning = -1
  End If
  
EndHandler:
  If Err.Number <> 0 Then SavePlanning = Err.Number
End Function

Encore merci.

Pas de quoi… ;)

Comme je l'ai précisé, il convient de vérifier que les valeurs saisies correspondent à ce qui est attendu. Donc, normalement, lors du clic sur Valider, on devrait passer par une fonction booléenne qui renvoie VRAI si tout est correct. Dans le cas de figure que j'ai illustré, on devrait vérifier que chaque textbox contient une valeur qui peut être convertie en heures par la fonction cDate. On pourrait également décider que si un textbox est vide, on met du vide dans la cellule…

Dans un premier temps, on peut remplacer la ligne en rouge par le bloc suivant qui teste que la conversion est possible. Si ok, on enregistre la valeur, sinon, en enregistre une chaine vide.
Code:

1 2 3 4 5 If IsDate(.Controls("tbo" & r & c).Value) Then DataRange(r, c).Value = CDate(.Controls("tbo" & r & c).Value) Else DataRange(r, c).Value = "" endif

09/08/2018, 15h06
Didpa

Merci,

Cela fonctionne,je regarde comment je vais pouvoir adapter tout cela à mon programme.

Cordialement

1 pièce(s) jointe(s)

Bonjour

Je suis toujours sur le code que vous avez créé Pierre Fauconnier. J'essais de l'adapter et de tout comprendre...pas toujours facile:roll::calim2:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Function getPlanningNames() Dim t ReDim t(0) Dim Counter As Long Dim rng As Range Set rng = Range("a4") Counter = 0 t(0) = rng.Value Set rng = rng.Offset(11) Do While rng.Value <> "" Counter = Counter + 1 ReDim Preserve t(Counter) t(Counter) = rng.Value Set rng = rng.Offset(11) Loop getPlanningNames = t End Function
Pièce jointe 403754

J'aurais voulu savoir s'il était possible sachant que tout mes plannings sont nommés
Planning_01 correspond à la cellule B6
Planning_12 correspond à la cellule U24 etc....

j'ai essayé de les appeler par leur nom mais sans succès :
De remplacer :

Code:

Set rng = Range("a4")

par

Code:

Set rng = Range(usfPlanning.cboPlanning).Value

car avec cela est plus compliqué car la taille des planning diffères et ne sont plus sur la même colonne.

Code:

Set rng = rng.Offset(11)

cela fonctionne pour le planning hedomadaire, mais plus pour le bimensuel, trimensuel, et mensuel.

Je suis bloqué à ce niveau car je n'ai pas pu tester autre que du planning mensuel. Qui fonctionne plutôt bien.

Cordialement.

14/08/2018, 21h16
Pierre Fauconnier
Je n'ai pas bien compris où tu bloquais.

Les codes fournis correspondent au traitement des plannings hebdomadaires tels que décrits sur tes copies d'écran. Il faut donc adapter le code pour les autres plannings. (Désolé, j'ai mis un offset de 11 alors qu'apparemment c'est un offset de 14 puisqu'il y a 14 lignes entre chaque planning hebdo)

Idéalement, on devrait créer une fonction générique pour récupérer UN planning qui utiliserait une définition du type de planning. On remarque que
- chaque titre de planning d'un type est séparé du précédent pas un certain nombre de lignes;
- chaque planning utilise un certain nombre de plages de 7*4 cellules (hebdo 1, bimemsuel 2, ...);
- lorsqu'il y a plusieurs plages, chaque début de plage est séparé du début de la plage précédente de 9 lignes.
On pourrait donc créer des tableaux contenant une liste des premières cellules de chaque type avec le nom du tableau en fonction des décalages observés, par exemple dans une collection, puis, pour alimenter le usf d'un type, passer la cellule de début du planning ainsi que les infos de nombres de plages à récupérer.
Les listes déroulantes seraient alimentées par la liste des plannings de chaque type.