Problème avec barre de progression

**cluster26** · 20/07/2010, 20h05

Bonsoir,

Après avoir passé pas mal d'heures (sans résultat) sur l'incorporation d'une barre de progression dans mon code, je me décide de faire appel à vous.

J'ai récupéré sur
http://arkham46.developpez.com/artic...tente/#LII-D-1
le code me permettant créer un formulaire d'attente avec barre de progression.

Ce formulaire fonctionne très bien. Toutefois, je souhaiterais incorporer dans ce code l'opération d'ajout d'enregistrements dans une table.

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
Dim bd As Database, t As Recordset, tbis As Recordset
Set bd = CurrentDb
Set t = bd.OpenRecordset("SELECT * FROM articles)
Set tbis= bd.OpenRecordset("prévision")
 
t.MoveFirst
         Do Until t.EOF
 
..
..
..
 
tbis.AddNew
    tbis![ref] = t![ref]
tbis.Update
 
t.MoveNext
 Loop
t.Close
tbis.Close

l

Pouvez-vous me conseiller sur le positionnement du code dans le formulaire d'attente SVP

Merci à l'avance

**cluster26** · 21/07/2010, 08h02

Bonjour,

Après réflexion, je me rends compte que la description de mon problème ainsi que la demande de solution évoquées hier soir ne sont pas très claires !..

Pour faire court, l'objectif principal est d'alimenter ma table pendant qu'apparaît le formulaire d'attente.
Pour également faire simple, je vous affiche le code du formulaire d'attente que j'ai récupéré sur le site

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
Private Sub Commande0_Click()
Dim lCptIteration1 As Long
Dim lCptIteration2 As Long
Dim lString As String
Dim lPercent As Single
Const lNbIterations As Long = 10000
On Error GoTo Gestion_Erreurs
' Ouverture du formulaire d'attente
DoCmd.OpenForm "FormAttente"
Forms("FormAttente").lblInfo.Caption = "Veuillez patienter durant le traitement ... "
Forms("FormAttente").lblProgressBar.Width = 0
' Nécessaire pour redonner la main à windows le temps de traiter les messages dans la pile
DoEvents
' Boucle de traitement
For lCptIteration1 = 1 To lNbIterations
    For lCptIteration2 = 1 To 1000
        lString = Chr((lCptIteration1 + lCptIteration2) Mod 256)
    Next
    ' Toutes les 500 itérations
    If lCptIteration1 Mod 500 = 0 Then
        ' Calcul du pourcentage d'avancement
        lPercent = lCptIteration1 / lNbIterations
        ' Met à jour l'étiquette d'avancement
        Forms("FormAttente").lblProgress.Caption = "Traitement en cours ... " & Format(lPercent, "00%")
        ' Met à jour la barre de progression
        Forms("FormAttente").lblProgressBar.Width = Forms("FormAttente").lblProgressBack.Width * lPercent
        ' Repaint le formulaire
        Forms("FormAttente").Repaint
    End If
    ' Evite que l'application ne soit figée
    DoEvents
Next
' Fermeture du formulaire d'attente
DoCmd.Close acForm, "FormAttente"
Exit Sub
Gestion_Erreurs:
    MsgBox "Erreur lors du traitement, n° " & Err.Number & ", " & Err.Description, vbOKOnly
    DoCmd.Close acForm, "FormAttente"
End Sub

Je vous remercie à l'avance pour votre contribution

**LedZeppII** · 21/07/2010, 20h28

Bonsoir,

Voici un exemple :

Le traitement consiste à recopier les enregistrements d'une table source vers une table destination.
Tu devrais facilement trouver des analogies avec ton traitement.

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
Private Sub cmdTest_Click()
Dim lNbIterations As Long
Dim lCptIteration1 As Long
Dim lPercent As Single
Dim db As DAO.Database, rsSce As DAO.Recordset, rsDest As DAO.Recordset
 
' ---------------------------------------------------------
' Préparation traitement
' ---------------------------------------------------------
Set db = CurrentDb
' Vide table destination
db.Execute "DELETE FROM tblTest_cible"
' Ouvre table source
Set rsSce = db.OpenRecordset("SELECT * FROM tblTest")
' Ouvre table destination
Set rsDest = db.OpenRecordset("tblTest_cible")
' Nombre d'enregistrements à copier
If Not rsSce.EOF Then rsSce.MoveLast: rsSce.MoveFirst
lNbIterations = rsSce.RecordCount
 
' ---------------------------------------------------------
' Ouverture du formulaire d'attente
' ---------------------------------------------------------
DoCmd.OpenForm "FormAttente"
Forms("FormAttente").lblInfo.Caption = "Veuillez patienter durant le traitement ... "
Forms("FormAttente").lblProgressBar.Width = 0
' Nécessaire pour redonner la main à windows le temps de traiter les messages dans la pile
DoEvents
 
' ---------------------------------------------------------
' Boucle de traitement
' ---------------------------------------------------------
Do Until rsSce.EOF
    ' Mise à jour nbre de boucles réalisées
    lCptIteration1 = lCptIteration1 + 1
 
    ' Traitement : copie enregistrement
    rsDest.AddNew
      rsDest(0) = rsSce(0)
      rsDest(1) = rsSce(1)
      rsDest(2) = rsSce(2)
      rsDest(3) = rsSce(3)
    rsDest.Update
 
    ' Mise à jour progression
    If lCptIteration1 Mod 10 = 0 Then
        ' Calcul du pourcentage d'avancement
        lPercent = lCptIteration1 / lNbIterations
        ' Met à jour l'étiquette d'avancement
        Forms("FormAttente").lblProgress.Caption = "Traitement en cours ... " & Format(lPercent, "00%")
        ' Met à jour la barre de progression
        Forms("FormAttente").lblProgressBar.Width = Forms("FormAttente").lblProgressBack.Width * lPercent
        ' Repeint le formulaire
        Forms("FormAttente").Repaint
        ' Evite que l'application ne soit figée
        DoEvents
    End If
 
    rsSce.MoveNext
Loop
 
' ---------------------------------------------------------
' Fin de traitement
' ---------------------------------------------------------
rsDest.Close
rsSce.Close
 
' ---------------------------------------------------------
' Fermeture du formulaire d'attente
' ---------------------------------------------------------
DoCmd.Close acForm, "FormAttente"
End Sub

A+