Afficher une msgbox ou une autre forme "Veuillez patienter pendant le traitement" pendant la mise à jour [Résolu]

[lakhdar16]

Bonjour,

Dans ma base de donnée, je dois mettre à jour la table " t_pdv" via un bouton qui exécute le code, cette action prend quelques minutes, je veux afficher un autre form indiquant au client de patienter pendant le traitement de la mise à jour, et qui empêche l'accès à d'autres formulaires (fen indépendante) pendant la mise à jour puis elle se ferme automatiquement.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
 
Private Sub Commande0_Click()
 
DoCmd.SetWarnings False
MsgBox " veuillez patientez pendant le traitement", vbOKOnly, "mise à jour des données"
 
DoCmd.RunSQL "delete * from t_pdv"
DoCmd.RunSQL "INSERT INTO [t_pdv] SELECT * FROM [t_pdv1]"
 
DoCmd.SetWarnings True
 
End Sub

svp quelqu'un a une idée à propos de ça.

J'ai à la fonction do until et loop mais là ma tête bloque

merci d'avance pour votre aide.

[GAYOT]

Bonjour
Si cela prend plusieurs minutes, cela vaut peut être le coup de lire ceci:
http://arkham46.developpez.com/artic...s/formattente/

[lakhdar16]

Bonjour,

merci pour votre réponse, je vais lire attentivement le tutoriel que vous avez posté et je vous rentrerais réponse dès l'essai.

merci encore

[Domi2]

Bonsoir,

Le tutoriel d'Arkham46 ne répond malheureusement pas à ton besoin, il est prévu pour afficher une barre de progression lorsque tu utilises un traitement en boucle, ce qui n'est pas le cas ici.

Voir par exemple cette discussion.

Si tu as vraiment besoin d'afficher une barre de progression autre que celle d'Access, il te faudra effectuer ton traitement en utilisant un Recordset.

Domi2

[lakhdar16]

bonsoir,

vraiment je suis perdu, et j'ai la tête qui bloque
j'ai essayé le premier tutoriel d'Arkham46 qui est riche en infirmations, mais c'est pas le cas que je cherche car j'utilise pas une boucle de traitement, et je tiens à remercier GAYOT pour son aide.
dans la discussion proposée par Domi2, j'ai presque fais la même chose mais le code bloque sur

Code :

ProgressBar.Visible = True

objet requit

j'ai pensé peut être à ajouter une référence liée au progressBar mais c'est introuvable,

je voulais rassembler le tutoriel Arkham46 et le code de la discussion proposée par Domi2 en définissant la valeur progressMax et ProgressMin ... sans espoir ... là je suis en mode bug ...

nb: la requête que j'execute copie tout les enregistrement de la table t_pdv liée par ODCB, dans la table t_pdv1 ... cette action prends environ 03 minutes, le curseur se transforme en sablier et on a l'impression que l'application est bloquée mais en réalité la requête est entrain de s'exécuter.

c'est pour cela que je voulais trouver un moyen pour afficher un formulaire avec une barre de progression de la mise à jour indiquant au client de se patienter pendant le traitement des données.

si vous pouvez m'expliquer le fonctionnement ou me diriger afin que je puisse réaliser cette petite tache qui me paris difficile

merci d'avance.

[lakhdar16]

Bonjour,

j'ai arrivé à afficher le contrôle active x microsoft progressBar, mais j'ai un petit souci, c'est que j'arrive pas à faire progresser la barre en parallèle avec l'avancement de la requête, ci-dessous le code de progressBar

Code :

1
2
3
4
5
6
7
BarProgress.min = 0 
BarProgress.max = Dcount ( "*", "t_pdv") 
i=1 
While i <= BarProgress.max 
     BarProgress.value = i 
     i=i+1 
Wend

la requete:

Code :

DoCmd.RunSQL "INSERT INTO [t_pdv1] SELECT * FROM [t_pdv]"

j'ai essayé d'intégrer cette requête dans le code de progressBar mais ça tourne en boucle, pour chaque "i" la requête s'exécute

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
BarProgress.min = 0 
BarProgress.max = Dcount ( "*", "t_pdv")
BarProgress.Visible = True 
 
i=1 
 
While i <= BarProgress.max
 
DoCmd.RunSQL "INSERT INTO [t_pdv1] SELECT * FROM [t_pdv]"
 
DoEvents 
     BarProgress.value = i 
     i=i+1 
Wend 
 
BarProgress.Value = 0
BarProgress.Visible = False

comment puis-je faire progresser la barre en parallèle avec l'avancement de la requête?, pourriez vous m'indiquer ou ce trouve l'erreur ?.

merci à vous.

[LedZeppII]

Bonjour,

Je suis d'accord avec Domi2 :

Envoyé par Domi2

Si tu as vraiment besoin d'afficher une barre de progression autre que celle d'Access, il te faudra effectuer ton traitement en utilisant un Recordset.

Pendant l'exécution de ...

Code :

DoCmd.RunSQL "INSERT INTO [t_pdv1] SELECT * FROM [t_pdv]"

... l'exécution du code VBA et suspendue.
On ne peut donc pas, par code, afficher la progression de l'exécution de l'instruction SQL INSERT.

Si tu veux vraiment afficher une progression, il te faut deux recordsets.
Un sur la table source t_pdv pour lire les données, et un sur la table destination t_pdv1 pour ajouter des données.

A+

[lakhdar16]

bonjour,

j'ai essayé la méthode de Recordset mais je sais j'arrive pas,

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim PDV1 As Recordset ' table source
Dim PDV As Recordset ' table qui reçoit les données
Dim mdb As Database
Dim Nenrg As Long
 
Set mdb = CurrentDb
 
Set Ors = mdb.OpenRecordset ("select * from t_pdv1") 
ProgressBar.Max = Ors.RecordCount  ' Nombre d'enregistrement à copier
 
Set Ons = mdb.OpenRecordset("select * from t_pdv") 
 
 
Nenrg = Ons.RecordCount '  nombre d'enregistrement inséré DANS LA TABLE PDV

je veux faire progresser la barre en parallèle AVEC nombre d'enregistrement copiés dans la table "t_pdv".

la valeurs maxi du progressBar = nombre d'enregistrement de la table sourse "t_pdv1" (à copier)
la valeurs mini du progressBar = 1

la requête:

Code :

DoCmd.RunSQL "INSERT INTO t_pdv SELECT * FROM t_pdv1"

puis-je avoir de l'aide svp... j'ai pas pu faire ça.

Où dois-je mette la la requête afin que le progressbar augmente vis-à-vis l'exécution .

merci à vous.

[LedZeppII]

Bonjour,

Voici un exemple de code pour vider la table t_pdv et ensuite copier t_pdv1 dans t_pdv :

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
Dim db As DAO.Database
Dim rsS As DAO.Recordset  ' Source
Dim rsD As DAO.Recordset  ' Destination
Dim lgTotEnr As Long, lgEnr As Long
Dim iChp As Integer, sNomChp As String
 
Set db = CurrentDb
' Vide table destination
db.Execute "DELETE FROM t_pdv"
 
' Ouvrir Table Source
Set rsS = db.OpenRecordset("t_pdv1", dbOpenSnapshot)
' Si elle est vide on quitte
If rsS.EOF Then
   rsS.Close
   Exit Sub
End If
 
' Aller au dernier enregistrement
rsS.MoveLast
' Mémoriser le nombre d'enregistrents
lgTotEnr = rsS.RecordCount
' Revenir au premier enregistrement
rsS.MoveFirst
 
' Ouvrir table destination
Set rsD = db.OpenRecordset("t_pdv", dbOpenDynaset)
 
' Boucler sur les enregistrements Source
Do
    ' Compteur enregistrement
    lgEnr = lgEnr + 1
    ' Ajouter un enregistrement
    rsD.AddNew
    ' Recopier les champs
    For iChp = 0 To rsS.Fields.Count - 1
        sNomChp = rsS.Fields(iChp).Name
        rsD.Fields(sNomChp) = rsS.Fields(iChp)
    Next
    ' Sauver le nouvel enregistrement
    rsD.Update
 
    ' Enregistrement Source suivant
    rsS.MoveNext
Loop Until rsS.EOF
 
rsD.Close
rsS.Close

Avec les variables lgEnr et lgTotEnr tu peux gérer l'affichage de ta barre de progression.

A+

[lakhdar16]

Bonjour,

désolé pour le retard, et je tiens à vous remercier pour vos réponses.

j'ai réussi à fusionner le code que vous m'avez donné avec le tutoriel proposé par GAYOT "Traitement en boucle" mais j'ai pris que la première partie.

à présent l'avancement de la barre de progression par rapport à la requête d'ajout marche nickel, mais avant l'exécution de la requête d'ajout j'ai deux autres action qui précédent,

1 - suppression de tout les enregistrement de la table t_pdv
2 - connexion à la table source t_pdv1 via ODBC

ci-dessous le code:

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
Private Sub Commande0_Click()
 
Dim lPercent As Single
Dim db As DAO.Database
Dim rsS As DAO.Recordset  ' Source
Dim rsD As DAO.Recordset  ' Destination
Dim lgTotEnr As Long, lgEnr As Long
Dim iChp As Integer, sNomChp As String
 
 
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
 
Set db = CurrentDb
 
' Vide table destination
db.Execute "DELETE FROM t_pdv"
 lgEnr = 0
 
' Ouvrir Table Source
Set rsS = db.OpenRecordset("t_pdv1", dbOpenSnapshot)
' Si elle est vide on quitte
If rsS.EOF Then
   rsS.Close
   Exit Sub
End If
 
' Aller au dernier enregistrement
rsS.MoveLast
' Mémoriser le nombre d'enregistrents
lgTotEnr = rsS.RecordCount
' Revenir au premier enregistrement
rsS.MoveFirst
 
 
' Ouvrir table destination
Set rsD = db.OpenRecordset("t_pdv", dbOpenDynaset)
 
' Boucler sur les enregistrements Source
Do
    ' Compteur enregistrement
    lgEnr = lgEnr + 1
    ' Ajouter un enregistrement
    rsD.AddNew
 
    ' Recopier les champs
For iChp = 0 To rsS.Fields.Count - 1
        sNomChp = rsS.Fields(iChp).Name
        rsD.Fields(sNomChp) = rsS.Fields(iChp)
 
Next
    ' Sauver le nouvel enregistrement
    rsD.Update
 
    ' Enregistrement Source suivant
    rsS.MoveNext
 
If lgEnr Mod 100 = 0 Then
        lPercent = lgEnr / lgTotEnr
        ' Met à jour l'étiquette d'avancement
        Forms("FormAttente").lblProgress.Caption = "Traitement en cour..." & Format(lPercent, "00%")
        Forms("FormAttente").lblProgressInfo.Caption = "Mise à jour"
        ' Met à jour la barre de progression
        Forms("FormAttente").lblProgressBar.Width = Forms("FormAttente").lblProgressBack.Width * lPercent
        ' Repaint le formulaire
        Forms("FormAttente").Repaint
        DoEvents
End If
 
Loop Until rsS.EOF
 
rsD.Close
rsS.Close
 
    ' Evite que l'application ne soit figée
DoEvents
 
MsgBox " Mise à jour réussi"
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

quand je clique sur le bouton d'exécution:

1 - exécution de la requête de suppression
2- l'application ce bloque au moment de connexion ODBC
3 - exécution de la requête d'ajout.

comment puis-je contourner le blocage lors de la connexion à la table source via ODBC.
et comment puis-je progresser la barre avec la suppression des enregistrement en sachant le nombre total d'enregistrement à effacer.

en résumé je veux réaliser ce qui suit:

1 - progresser la barre avec la suppression
2 - libérer l'application lors de la connexion à la table source t_pdv1
3 - progresser la barre avec la requête d'ajout (résolu)

merci d'avance pour votre aide.

[LedZeppII]

Bonjour,

1 - progresser la barre avec la suppression
En principe une instruction DELETE ... FROM n'est pas très longue.
Je ne crois pas que ça soit valable de supprimer les enregistrements un par un, pour afficher une barre de progression.
Ça va être plus long.

2 - libérer l'application lors de la connexion à la table source t_pdv1
Je ne sais pas faire.
L'application fige à cause du temps d'exécution combiné, de l'ouverture du recordset et du positionnement sur le dernier enregistrement (rsS.MoveLast).
Tu peux éventuellement essayer de remplacer

Code :

1
2
3
4
5
6
' Aller au dernier enregistrement
rsS.MoveLast
' Mémoriser le nombre d'enregistrents
lgTotEnr = rsS.RecordCount
' Revenir au premier enregistrement
rsS.MoveFirst

par

Code :

1
2
' Mémoriser le nombre d'enregistrements
lgTotEnr = DCount("*", "t_pdv1")

... pour gagner du temps.

A+

[lakhdar16]

Bonjour,

merci pour votre réponse.

j'ai modifié la partie dont vous m'avais parler en utilisant l'instruction "DCount" mais le problème persiste, je pense que le problème est lié à l'ouverture de la table source située dans le serveur de mon entreprise.

j'ai essayé de mettre le "DoEvents" après le "DCount" mais sans issue...!!!

y-a il un moyen pour libérer l'application au moment de la connexion au serveur?

merci à vous.

[LedZeppII]

Bonsoir,

Je vais te montrer ce que j'ai essayé en utilisant ADO à la place de DAO.
Mon code copie une table tblTest d'une autre base de données Access, dans une table tblTest2 locale.
Les deux tables ont exactement les mêmes champs.
Sur le clic d'un bouton j'appelle la procédure tstINSERTenADO() dont le code est dans le module de code du formulaire.
J'affiche les étapes de progression dans l'étiquette lblStatut.

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
Sub tstINSERTenADO()
Dim oCnS As ADODB.Connection ' Connexion Source
Dim oRsS As ADODB.Recordset  ' Recordset Source
Dim oCnD As ADODB.Connection ' Connexion Destination
Dim oRsD As ADODB.Recordset  ' Recordset Destination
Dim sSqlS As String, sSqlD As String
Dim lgTotEnr As Long, lgEnr As Long
Dim iChp As Integer, sNomChp As String
 
Dim lgLoopCnt As Long
 
' ** Ouverture Connexion Source **
Set oCnS = New ADODB.Connection
oCnS.CursorLocation = adUseClient
oCnS.ConnectionTimeout = 60  ' Timeout connexion 1mn
oCnS.CommandTimeout = 300    ' Timeout requête   5mn
oCnS.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                         "F:\Access\tmpDB1.mdb" & ";User ID=Admin"
oCnS.Open
 
' ** Ouverture Connexion Destination **
' Comme c'est Access, on utilise la connexion du projet
Set oCnD = CurrentProject.Connection
 
' Vide table destination
oCnD.Execute "DELETE FROM tblTest2", , adCmdText
 
' ** Ouverture recordset sur données sources **
'    Préparation recordset
Set oRsS = New ADODB.Recordset
oRsS.CursorLocation = adUseClient
oRsS.CursorType = adOpenStatic
oRsS.LockType = adLockReadOnly
Set oRsS.ActiveConnection = oCnS
sSqlS = "SELECT [ID], [Dt], [Week], " & _
        "(SELECT T2.[Test] From tblTest As T2 WHERE T2.[ID] = T1.[ID]) AS test " & _
        "FROM tblTest As T1"
' Ouverture asynchrone du recordset
oRsS.Open sSqlS, , , , adCmdText Or adAsyncFetch
 
' Boucle d'attente
Do
    lgLoopCnt = lgLoopCnt + 1
    If (lgLoopCnt Mod 2) = 0 Then
        Me.lblStatut.Caption = "Ouverture"
    Else
        Me.lblStatut.Caption = "Ouverture ..."
    End If
    Me.Repaint
    ' Le DoEvents fait que Access ne fige pas
    DoEvents
Loop Until (oRsS.State = adStateOpen)
 
' Si le recordset est vide on quitte
If oRsS.BOF And oRsS.EOF Then
   GoTo Sortie
End If
 
' Mémoriser le nombre d'enregistrements sources
lgTotEnr = oRsS.RecordCount
' Remarque sur .RecordCount:
' Selon le provider de la connexion et/ou les paramètres du recordset
' il se peut que RecordCount retourne toujours -1
 
' ** Ouverture recordset sur table destination **
' Préparation recordset
Set oRsD = New ADODB.Recordset
oRsD.CursorLocation = adUseClient
oRsD.CursorType = adOpenStatic
oRsD.LockType = adLockOptimistic
Set oRsD.ActiveConnection = oCnD
sSqlD = "SELECT * FROM tblTest2"
' Ouverture recordset
oRsD.Open sSqlD, , , , adCmdText
 
' Boucler sur les enregistrements Source
' et les ajouter au recordset Destination
Do
    ' Compteur enregistrement
    lgEnr = lgEnr + 1
    ' Ajouter un enregistrement
    oRsD.AddNew
    ' Recopier les champs
    For iChp = 0 To oRsS.Fields.Count - 1
        sNomChp = oRsS.Fields(iChp).Name
        oRsD.Fields(sNomChp).Value = oRsS.Fields(iChp).Value
    Next
    ' Sauver le nouvel enregistrement
    oRsD.Update
    '
    If (lgEnr Mod 100) = 0 Then
        Me.lblStatut.Caption = "Copie (" & Round(100 * lgEnr / lgTotEnr, 0) & "%)"
        DoEvents
    End If
    ' Enregistrement Source suivant
    oRsS.MoveNext
Loop Until oRsS.EOF
 
Sortie:
' Fermeture et libération des objets ADO
If Not (oRsD Is Nothing) Then
   If oRsD.State <> adStateClosed Then oRsD.Close
End If
Set oRsD = Nothing
Set oCnD = Nothing
 
If Not (oRsS Is Nothing) Then
   If oRsS.State <> adStateClosed Then oRsS.Close
End If
Set oRsS = Nothing
 
If Not (oCnS Is Nothing) Then
   If oCnS.State <> adStateClosed Then oCnS.Close
End If
Set oCnS = Nothing
 
End Sub

Ici ...

Code :

1
2
oCnS.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
                         "F:\Access\tmpDB1.mdb" & ";User ID=Admin"

... il te faut mettre une chaîne de connexion ADO (OLE DB) correspondant à la source de données à laquelle tu veux te connecter.
Voir http://www.connectionstrings.com/

A partir de la connexion ADO (oCnS) sur la source de données, ADO nous permet d'ouvrir le recordset de manière asynchrone.
On peut alors entrer dans une boucle, jusqu'à ce que le recordset soit ouvert.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
' Ouverture asynchrone du recordset
oRsS.Open sSqlS, , , , adCmdText Or adAsyncFetch
 
' Boucle d'attente
Do
    lgLoopCnt = lgLoopCnt + 1
    If (lgLoopCnt Mod 2) = 0 Then
        Me.lblStatut.Caption = "Ouverture"
    Else
        Me.lblStatut.Caption = "Ouverture ..."
    End If
    Me.Repaint
    ' Le DoEvents fait que Access ne fige pas
    DoEvents
Loop Until (oRsS.State = adStateOpen)

A+

[lakhdar16]

Bonjour,

je te remercie infiniment pour ta réponse, et pour ta proposition,à mon avis la méthode ADO est plus fiable que la méthode DAO , le traitement de la requête se fasse rapidement je gagne 00:01:30 du temps estimé.

j'ai remplacé la suppression des enregistrement de la table destination "tbl_pdv" par un jeux de requêtes :

- créer une copie de ta table tbl_pdv " structure seulement"
- renommer la table "tbl_pdv" en tbl_pdv2"
- renommer la table "tbl_pdv1" en tbl_pdv"

et après l'exécution de la requête mise à jour je supprime la table tbl_pdv2

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
' Vide table destination
'oCnD.Execute "DELETE FROM tbl_pdv", , adCmdText
Me.lblStatut.Caption = "suppression des données temporaires ..."
DoCmd.TransferDatabase acImport, "Microsoft Access", strPath, acTable, "tbl_pdv", "tbl_pdv", True ' par defaut  la nouvelle table prends le nom tbl_pdv1
db.TableDefs("tbl_pdv").Name = "tbl_pdv2"
db.TableDefs("tbl_pdv1").Name = "tbl_pdv"
DoEvents
.
.
.
.
.
.
.
Loop Until oRsS.EOF
 
DoCmd.DeleteObject acTable, "tbl_pdv2"

j'ai rajouter aussi la gestion du temps restant pour finir l'exécution en sachant le T départ.

Code :

1
2
'calculer la différence du temps
TimeSize = TimeNow - StartTime

puis on calcule le temps restant estimé:

Code :

1
2
3
4
' afficher le temps restant
Me.ProgressTime.Caption = "temps Restant:   " & Format(((TimeSize * (lgTotEnr - lgEnr) / lgEnr)), "ttttt")
'afficher le nombre de données transféré
Me.Nbcopier.Caption = "Nombre de données transféré:  " & lgEnr & "  sur  " & lgTotEnr

la suppression des enregistrements via une instruction SQL prend beaucoup de temps pour s'exécuter en cas d'un grand nombre d'enregistrements (dans mon cas plus que 90000 enrg). alors j'ai pensé à cette méthode qui me permettre de gagner du temps et d'avoir un buckup en cas d'erreur de connexion au serveur.

quand je lance le code, l'application semble figé pendant "20 seconde" au moment du l'exécution de la première partie ( création de la nouvelle table .. ect ...); est-il possible de contourner ça pour évité ce défaut??

tes suggestions et propositions son les bienvenues, j'avoue que tu m'as beaucoup aidé dans cette partie de mon application. et je tiens à te remercie pour ça.

cordialement.

[LedZeppII]

Bonsoir,

Je crois que je suis allé au bout de ce que je sais faire
Désolé

A+

[lakhdar16]

Bonsoir,

merci commeme tu m'as beaucoup aidé , je pense qu'il n'y a pas de solution à ce petit problème.

merci encore.