Intégration d'une barre de progression

Sub Delayed()

'Déclaration des variables
Dim ID As String
Dim nbr As Integer
Dim Derlig As Integer
Dim x As String
Dim y As Integer
Dim i As Integer
Dim Program As String
Dim PO As String
Dim PO_Date As Date
Dim Content As String
Dim Deliv_Target_Date As Date
Dim Deliv_Date_OTD1 As Date
Dim Deliv_Time_OTD1 As String

'Effacer la zone B3 à C1000
Range("B3:C1000").Select
Selection.ClearContents

'La mise à jour du tableau doit impérativement avoir été effectuée ("FOLLOW_UP_TEST.xlsm" ; onglet "Feuil1).
If MsgBox("Have you updated the table from the tab 'Feuil1' ?", vbYesNo, "Confirmation Request") = vbNo Then
MsgBox ("Thank you for updating the 'Feuil1' tab.")
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate
Exit Sub
Else
End If

'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False

'On se positionne dans le fichier "FOLLOW_UP_TEST.xlsm" et dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate

Dossier_racine = Range("Z1").Value
'MsgBox ("Dossier racine = " & Dossier_racine)

nbr = 0

'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> derlig
'Recherche du nombre de références ID en colonne B --> nbr
Derlig = Application.WorksheetFunction.CountA(Range("B:B")) + 3
nbr = Range("B6:B" & Derlig).SpecialCells(xlCellTypeVisible).Count

'MsgBox ("Derlig = " & Derlig)

'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr & " ID's references")

'Initialisation des compteurs (on part de la ligne 6)
i = 1
y = 6

'Boucle sur le nombre de références ID, nbr (remplissage du tableau)
While i <= nbr

'MsgBox ("i = " & i)
'MsgBox ("y = " & y)

'On se positionne dans le fichier "FOLLOW_UP_TEST.xlsm" et dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("Feuil1").Activate

'x correspond à la valeur de la cellule B6 (à la première boucle, première valeur de la liste)
x = Range("B" & y).Value


'MsgBox ("x = " & x)

'MsgBox ("Dossier racine = " & Dossier_racine)

'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate

'MsgBox ("on est dans " & "Entry_Form_" & x & ".xlsm" & " onglet ADD_INFOS")

'Récupération de la date OTD1
Deliv_Time_OTD1 = Range("H9").Value

'MsgBox ("Deliv_Time_OTD1 = " & Deliv_Time_OTD1)

If Deliv_Time_OTD1 = "On time" Then

'MsgBox ("on est dans le cas où c'est On time")
'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False
y = y + 1
i = i + 1

Else
'MsgBox ("on est dans le cas où c'est DELAYED")
'Mise en mémoire des données du fichier "Entry_Form_ID.....xlsm". Celles-ci sont à rapatrier dans le fichier "FOLLOW_UP_TEST.xlsm"
ID = "ID" & Range("C6").Value
'MsgBox ("ID = " & ID)
Deliv_Date_OTD1 = Range("H8").Value
'MsgBox ("Deliv_Date_OTD1 = " & Deliv_Date_OTD1)

'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "DELAYED_OTD1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("DELAYED_OTD1").Activate

'MsgBox ("on est dans l'onglet DELAYED_OTD1")

'On colle les valeurs précédemment mises en mémoire dans le fichier "FOLLOW_UP_TEST.xlsm" (onglet "DELAYED")
Range("B" & y - 3).Value = ID
'MsgBox ("pause")
Range("C" & y - 3).Value = Deliv_Date_OTD1
'MsgBox ("pause")
y = y + 1
'MsgBox ("y = " & y)
i = i + 1

'MsgBox ("i = " & i)

'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False

End If

Wend

'On active le fichier "FOLLOW_UP_TEST.xlsm" et on se mets dans l'onglet "DELAYED_OTD1"
Windows("FOLLOW_UP_TEST.xlsm").Activate
Sheets("DELAYED_OTD1").Activate

Range("A1").Select

MsgBox ("Delayed extract finished")

Application.EnableEvents = True

End Sub