Bonjour,

J'ai un planning et quand je navigue entre les semaines, chaque case se met à jour.

Depuis que j'ai fait une fonction la navigation entre les semaines est lente.

J'ai une première fonction qui est la suivante :

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
 
Private Sub Remplir_Planning(ByVal Datest As String, ByVal Idc As Integer, ByVal Chrono As String, ByVal Intitule As String, ByVal Rang As String, ByVal Datec As String)
 
Dim db As Database
Set db = CurrentDb
 
Dim rqChrono As Recordset
Dim Chro As Long
 
Dim Datev As Date
Dim Id As Integer
 
Dim maDate As String
 
Dim rqVisites As Recordset
Dim Inti As String
Dim Rg As String
Dim Date_Contact As Date
 
'récupère la date du planning
maDate = Me.Controls(Datest).Value
Datev = Left(maDate, 2) & Right(scrCDate, 8)
 
'requête pour récupérer le chrono
Set rqChrono = db.OpenRecordset("SELECT Chrono From CRP WHERE Date = #" & Datev & "# And ID_Employe = " & Idc)
 
If rqChrono.EOF = False Then
    Chro = rqChrono(0)
Else
    Chro = 0
End If
 
If (Chro <> 0) Then
    Set rqVisites = db.OpenRecordset("SELECT Intitule, Rang,Date_Prise_Contact FROM Visites WHERE Chrono = " & Chro)
    If rqVisites.EOF = False Then
        Inti = rqVisites(0)
        Rg = rqVisites(1)
        Date_Contact = rqVisites(2)
    Else
        Inti = ""
        Rg = ""
        Date_Contact = Null
    End If
    'insertion du chrono sur le planning
    Me.Controls(Chrono).Value = Chro
    Me.Controls(Intitule).Value = Inti
    Me.Controls(Rang).Value = Rg
    Me.Controls(Datec).Value = Date_Contact
Else
    Me.Controls(Chrono).Value = Null
    Me.Controls(Intitule).Value = ""
    Me.Controls(Rang).Value = ""
    Me.Controls(Datec).Value = Null
End If
 
End Sub
Elle me permet de mettre à jour chaque cellule de mon planning.

J'ai la seconde fonction suivante qui utilise une boucle pour appeler autant de fois que nécessaire la fonction précedente.

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
 
Private Sub Boucle_Remplir_Planning()
 
Dim CRP() As Variant
Dim Compteur As Integer
Dim nb_Ele As Integer
Dim num_Colonne As Integer
Dim Compteur3 As Integer
Dim palier As Integer
 
CRP = Array(36, 37, 39, 40, 41, 47) 'ID_employe de touys les CRP présents dans la table employe
nb_Ele = UBound(CRP) + 1 'nombre d'élèment du tableau CRP
Compteur = 0
palier = 1
Compteur3 = 1 'numéro de chaque case du planning  pour chaque crp
 
 
'Permet de parcourir tous les élèments du tableau
While Compteur < nb_Ele
    num_Colonne = 1
    palier = palier + 7
    While Compteur3 < palier
    Call Remplir_Planning("C" & Format(num_Colonne, "00"), CRP(Compteur), "Chrono" & Compteur3, "Intitule" & Compteur3, "Rang" & Compteur3, "Date" & Compteur3)
    num_Colonne = num_Colonne + 1 'de 1 à 7 à chaque boucle
    Compteur3 = Compteur3 + 1
    Wend
    Compteur = Compteur + 1
Wend
End Sub
Si quelqu'un pourrait m'aider à rendre ce code plus rapide je l'en remercie beaucoup.

Sinon ne serait-il pas mieux d'appeler la fonction autant de fois que nécessaire au lieu d'utiliser une boucle??

merci beaucoup à ceux qui se pencheront sur mon problème.