Barre de progression

[YaGo]

Bonjour à tous,

J'ai réalisé un userform avec une barre de progression qui évolue au cours du temps de calcul malheuresement, celle-ci ne se met pas à jour en même temps que la réalisation de la boucle du programme.

Il y a t'il une propriété spécifique à sélectionner pour mon userform et ma barre de progression qui est une image d'ont la longueur est incrémenté?

De plus, je ne sais pas si la fonction DoEvents est situé au bon endroit?

Ci-dessous moncode VBA.

Cordialement,

Ya-Go

Sub CollectRatio()
Call Table_Initialize
Application.ScreenUpdating = False
Dim WorkbookMaster As Workbook, WorkbookSlave As String
Dim Ratio, KeyValue, Table, TabTotal
Dim i As Integer, LastRowTab As Integer, NbFile As Integer, IndexFile As Integer, Nb As Single, Progress As Single

Set WorkbookMaster = ActiveWorkbook
Set Ratio = WorkbookMaster.Sheets("Tableau")
WorkbookSlave = Dir(ActiveWorkbook.Path & "\KV*.xls")

Do While WorkbookSlave <> ""
NbFile = NbFile + 1
WorkbookSlave = Dir ' Classeur suivant
Loop

ProgressUserForm.Show
Nb = 0
Progress = 0
WorkbookSlave = Dir(ActiveWorkbook.Path & "\KV*.xls")
Do While WorkbookSlave <> ""
Set KeyValue = Workbooks.Open(ActiveWorkbook.Path & "\" & WorkbookSlave)
Set Table = KeyValue.Sheets("Tableau")

LastRowTab = Range("A6").End(xlDown).Row 'Dernière ligne de la base de données esclave
TabTotal = Range("A6:W" & LastRowTab) 'Mise en place des valeurs dans le tableau esclave
For i = LBound(TabTotal) To UBound(TabTotal)
Nb = Nb + 1
If Nb Mod Round(((LastRowTab * NbFile) / 100), 0) = 0 Then
Progress = Progress + 1
ProgressUserForm.ProgressBar.Width = Progress * 3.64
ProgressUserForm.ProgressPourcent.Caption = Progress & "%"
DoEvents
End If
If Len(TabTotal(i, 20)) <> 0 And TabTotal(i, 21) = "1" And Len(TabTotal(i, 22)) <> 0 And TabTotal(i, 23) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 2
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value + Cells(i + 5, 22).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value + Cells(i + 5, 22).Value
End If
ElseIf Len(TabTotal(i, 20)) <> 0 And TabTotal(i, 21) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 1
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 20).Value
End If
ElseIf Len(TabTotal(i, 22)) <> 0 And TabTotal(i, 23) = "1" And Ratio.Cells(i + 5, 5) = TabTotal(i, 5) And Ratio.Cells(i + 5, 6) = TabTotal(i, 6) Then
Counter(i) = Counter(i) + 1
If IndexFile + 1 = NbFile Then
Ratio.Cells(i + 5, 8) = (Ratio.Cells(i + 5, 8) + Cells(i + 5, 22).Value) / Counter(i)
Else
Ratio.Cells(i + 5, 8) = Ratio.Cells(i + 5, 8) + Cells(i + 5, 22).Value
End If
End If
Next

Application.DisplayAlerts = False
Workbooks(WorkbookSlave).Close
IndexFile = IndexFile + 1
WorkbookSlave = Dir ' Classeur suivant
Loop
ProgressUserForm.Hide
Application.ScreenUpdating = True
End Sub

 

[Modeste geedee]

Re : Barre de progression

Bonsour®

...

l'actualisation de la barre de progression est inhibée par :
Application.ScreenUpdating = False

 

[YaGo]

Re : Barre de progression

Boujour Modeste Geedee,

Merci pour ton aide mais le fait de supprimer Application.ScreenUpdating = False ne change rien...
La barre continu toujours à rester fixe.
Il doit donc avoir une erreur à un autre endroit en plus de celle-ci.

 

[Modeste geedee]

Re : Barre de progression

Bonsour®

mettre un point d'arret sur la ligne :
For i = LBound(TabTotal) To UBound(TabTotal)
puis faire F5 ou F8 pour consulter les différentes variables dont Progress

 

[YaGo]

Re : Barre de progression

J'ai déja tester les variables Progress, ProgressUserForm.ProgressBar.Width et ProgressUserForm.ProgressPourcent.Caption via MsgBox.
Elles prennent les bonnes valeurs à chaque incrémentation de Nb.