Index

Scénario1

On doit traiter 20 fichiers. Le temps de traitement est le même pour chacun des fichiers.
Sur l'exemple, le temps de traitement de chaque fichier est simulé par For a = 1 To 50000000: Next a

BarreProgression

Public témoin As Boolean
Sub Attente()
  n = 20                 ' nb de fichiers à traiter
  témoin = True ' pour empêcher fermeture du formulaire
  F_BarreAttente.Show
  For f = 1 To n
    '-- traitement
    For a = 1 To 50000000: Next a ' Simulation attente (mettre le programme réel)
    '--------------
    p = p + 1 / n ' calcul du pourcentage
    F_BarreAttente.Label1.Width = p * 100
    F_BarreAttente.Caption = Format(p, "0%")
    DoEvents
  Next f
  témoin = False
  Unload F_BarreAttente
End Sub

Le formulaire est non modal (showmodal=False) . Pour empêcher sa fermeture.

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If témoin Then Cancel = True
End Sub

Scénario2

Nous avons 4 traitements. Nous connaissons le temps de chaque traitement.

Sub Attente()
  F_BarreAttente.Show
  '==== traitement1
  F_BarreAttente.Caption = "20%"
  F_BarreAttente.Label1.Width = 20
  DoEvents
  For a = 1 To 100000000: Next a      ' simulation traitement (mettre programme réel)
  '==== traitement2
  F_BarreAttente.Caption = "40%"
  F_BarreAttente.Label1.Width = 40
  DoEvents
  For a = 1 To 100000000: Next a
  '==== traitement3
  F_BarreAttente.Caption = "60%"
  F_BarreAttente.Label1.Width = 60
  DoEvents
  For a = 1 To 100000000: Next a
  '==== traitement4
  F_BarreAttente.Caption = "80%"
  F_BarreAttente.Label1.Width = 80
  DoEvents
  For a = 1 To 100000000: Next a
  Unload F_BarreAttente
End Sub

Scénario3

On traite plusieurs fichiers (tous les fichiers ADO*) . Le temps de traitement de chaque fichier est proportionnel
à sa taille.
On calcule d'abord la taille totale des fichiers.

BarreProgression5

Sub Deroule()
  UserForm1.Show
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  repertoire = ThisWorkbook.Path & "\"
  '- calcul de la taille totale des fichiers commençant par ADO
  masque = "ADO*.xls"
  nf = Dir(repertoire & masque) ' premier fichier
  TailleTot = 0
  Do While nf <> ""
     TailleTot = TailleTot + FileLen(repertoire & nf)
     nf = Dir()
  Loop
  '-- traitement des fichiers
  nf = Dir(repertoire & masque)
  Do While nf <> ""
     Workbooks.Open Filename:=repertoire & nf
     ActiveWorkbook.Close
     p = p + FileLen(repertoire & nf) / TailleTot
     UserForm1.Label1.Width = p * 100
     UserForm1.Caption = Format(p, "0%")
     DoEvents
     nf = Dir()
  Loop
  Unload UserForm1
End Sub