Discussion :

[jojo86]

Bonjour,

J'aimerais afficher un userform avec une progress bar qui tourne en boucle pendant que du code s’exécute en arrière plan.
J'ai une procédure qui en appelle plusieurs autres. J'aimerais que tous le code roule en background mais je n'y arrive pas.

J'arrive à afficher le userform, mais il est soit tout blanc, soit il se fige... J'ai l'impression qu'il faudrait que je mette "DoEvents" partout mais c'est démesuré de vouloir faire ça.
J’espère donc avoir votre aide ou un exemple de fichier qui fait ça.

Merci d'avance.

Code du userform de progression

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Private Sub UserForm_Activate()
    UpdateProgressBar
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        StopProgressBar
End Sub

Code dans un module pour le userform :

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
 
Option Explicit
 
Private dtmDate As Date
Public Counter As Long
 
Sub UpdateProgressBar()
    Counter = (Counter + 1)
    If Counter > 100 Then Counter = 0
    UsfChargement.ProgressBar1.Value = Counter
    DoEvents
    dtmDate = Now + TimeSerial(0, 0, 1)
    Application.OnTime dtmDate, "UpdateProgressBar"
End Sub
 
Sub StopProgressBar()
    Application.OnTime dtmDate, "UpdateProgressBar", , False
End Sub

Un exemple succin de code qui appel le Userform

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
 
Sub DeplacerFichier()
Dim CheminSortie, dossiersource As String
Dim i, j As Integer
 
 
Application.DisplayAlerts = False
'Application.ScreenUpdating = False
 
UsfChargement.Show False
 
If PresenceDoublons = True Then
    PeuFermer = True
    UsfChargement.Hide
    MsgBox "Erreur, il existe des aubes en doublons dans le dossier : " & Sheets("Formulaire").Range("B1") & Chr(13) & _
    "Arrêt de la procédure. Veuillez supprimer l'un des deux fichiers", vbCritical, "Erreur"
    Exit Sub
End If
 
End Sub
 
Function PresenceDoublons() As Boolean
Dim requete As String
Call ConnexionBase(ThisWorkbook.FullName)
If SheetExists("Doublons") = True Then
    ThisWorkbook.Sheets("Doublons").Delete
End If
 
requete = "Select * From (Select Count(NomFichier) as NmbFichiers, NomFichier, Chemin, DateLastModif From [Indexation$] Where NomFichier " & _
          "In(Select UCase(SN) From [ImportPirat$]) Group By NomFichier, Chemin, DateLastModif) Where NmbFichiers>1"
Rst.Open requete, Cn, adOpenStatic
If Rst.RecordCount > 0 Then
    ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)).Name = "Doublons"
    With ThisWorkbook.Sheets("Doublons")
        .Range("A1") = "Nmb Doublons"
        .Range("B1") = "Fichier"
        .Range("C1") = "Chemin fichier"
        .Range("D1") = "Date Derniere Modif"
        .Range("A2").CopyFromRecordset Rst
    End With
    PresenceDoublons = True
Else
    PresenceDoublons = False
End If
Call DeconnexionBase
End Function

[Jean-Philippe André]

Salut,

regarde l'approche de cette progressbar Pacman
http://www.developpez.net/forums/d15...ss-bar-pacman/
ou la solution proposee ici
http://www.developpez.net/forums/d16...e-progression/

[jojo86]

Merci,
La deuxième solution n'est pas adaptée, puisqu'il s'agit de faire avancer la progress bar en fonction d'un nombre x de lignes ou de données (dans une boucle).
J'ai déjà fait des progress bar de ce type, je n'ai jamais eu de problème car on change le statut, puis on lance le code, puis on rechange le statut de la barre, et on lance le code etc etc...

Mon besoin est d'avoir une boucle qui tourne toute seule afin de modifier le statut de la barre automatiquement afin que la barre reparte à 0 si elle est à 100%, et en même temps, d'exécuter du code en arrière plan.

[Jean-Philippe André]

Oui je comprends bien,
tu peux tres bien utilise une notion de difference de Now() pour incrementer, avec retour a 0 lorsque tu arrives a 100% par exemple.

[jojo86]

Oui je comprends bien,
tu peux tres bien utilise une notion de difference de Now() pour incrementer, avec retour a 0 lorsque tu arrives a 100% par exemple.

Merci, mais si tu regardes mon code, tu verras que c'est ce que j'essaie de faire.
Mais soit mon formulaire se bloque en affichage, et la barre ne progresse pas, soit la macro se bloque sur le formulaire et le code ne se déroule pas... J'ai essayé différents trucs, et je n'arrive à rien ça fait longtemp que j'essaie de faire ça, mais je n'y suis jamais arrivé.

[jojo86]

J'arrive à faire fonctionner mon userform tout seul. Si je l'affiche seul, la barre défile comme je le souhaite.

Mais si je veux exécuter du code, alors ça plante tout.