Afficher une barre de progression pendant que le code s'exécute dans l'usf1

Bonjour,

J'ai repris le code de LouReed sur une barre de progression qui va être implémenté dans mon code.

La barre de progression s'affiche pendant que le code dans mon Userform1 exécute des opérations de copier/coller pendant 35 secondes en moyenne.

Sauf que dans ma procédure j'appelle la barre de progression et les opérations qui sont dans l'userform1 ne s'exécutent plus alors que je voudrais qu'il continue le code en parallèle.

Est-ce que c'est possible de faire exécuter le code du progress bar et continuer le code de l'UserForm1 en parallèle ?

Merci pour les réponses !

Bonne journée

Le code de LouReed, j'ai modifié le tempo à 0.7 et le nombre de boucle qui est passé à 50 afin que ça dure le temps exact de l'exécution du code

Sub Progression() ' 5 routines avec chacune 20% de progression avec des vitesses différentes
    Dim Segment, Progression, Taille, Tempo, I, TailleLabel2
    TailleLabel2 = 200 ' correspond à la taille du label vert du USF
    With Barre_Progression ' avec le USF
        Application.Cursor = xlWait ' on affiche le sablier pour faire patienter
        Taille = 0 ' on initialise la variable à 0 c'est le début de la progression
        .Label1.Width = Taille ' on réduit le Label2 à 0
        .Show vbModeless ' on affiche le USF mais on continue le traitement du code
        .Repaint ' on raffraichit le contenu affiché sinon on a une boite blanche vide (on ne sait jamais)

        ' on calcul la taille du segment pour chaque routine du code VBA, ici c'est 1/5, donc on divise par 5
        Segment = TailleLabel2 / 5

        ' première routine qui boucle 10 fois sur un code VBA quelconque
        ' c'est ce code qui devra être remplacé par le votre avec une taille de boucle adaptée à vos besoin
        For I = 1 To 50
            ' la boucle ci dessous ainsi que les autres sont là pour simuler le travail effectué par votre code VBA
            Tempo = Timer
            Do
                DoEvents
            Loop While Tempo + 0.7 > Timer
            ' progression est un incrément de 1 de la boucle en cours afin de faire progresser la barre
            Progression = Progression + 1
            ' le label2 augmente de la taille précédente du label + la part d'avancée de la barre dans le segment en cours
            .Label1.Width = Taille + Progression * Segment / 10
            ' on affiche l'avancée en % du code
            .Caption = "Process en cours... " & Int(.Label1.Width * 100 / TailleLabel2) & "%"
        Next I

        ' on met 'au propre' la variable Taille afin qu'elle soit égale à la largeur actuele du label2
        Taille = .Label1.Width
        ' on réinitialise la variable progression dans le segment qui passe donc à zéro car nouveau segment
        Progression = 0
        .Label1.Width = TailleLabel2
        .Caption = "Process terminé"
        ' on temporise
        Tempo = Timer
        Do
            DoEvents
        Loop While Tempo + 1.5 > Timer
        ' on masque le USF
        .Hide
        ' on remet le curseur par défaut
        Application.Cursor = xlDefault
    End With
End Sub

Mon code qui est censé s'exécuter pendant la progression du progress bar de LouReed.

Private Sub Info_Btn_Extract_Expertises_Click()
Dim Chemin As String, Fichier As String, time_backup As String, Chemin2 As String
Dim NBLig As Long

    time_backup = "--" & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & "--" & Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now()) & "--" & Environ("username")
    Chemin2 = "E:\PFE\Outil Procédures_Softs_Docs\7_EXTRACTIONS"
    UserForm1.Show vbModeless

    Call Progression
    Workbooks.Open Filename:="E:\PFE\Outil Procédures_Softs_Docs\Extract_Expertises.xlsx" 'Ouvre le fichier Excel destination
    Workbooks.Open Filename:="\\Vm-file-server1\actia_automotive\OEM\SHARE\y-Mass_Production_Engineering\vie serie\EXPERTISE\Synthèse Expertises.xlsx" 'Ouvre le fichier Excel source
    With Workbooks("Synthèse Expertises.xlsx")
        On Error Resume Next '................................................................................................en cas d'erreur (pas de données à filtrer),on poursuit la procédure
        Worksheets("items").ListObjects("Tableau1").Range.AutoFilter Field:=6, Criteria1:="=*" & Info_Nom_Prod & "*" '...........................................filtre le tabbleau 1 du Workboook Synthèse sur la colonne F
        NBLig = Range("Tableau1").Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 '.................................nombre de lignes filtrées
        If NBLig = 0 Then '..................................................................................................si aucune lignes filtrées, message + sortie de la procédure
            MsgBox "Le produit n'a jamais eu d'expertises dans la base de données", vbInformation
            Workbooks("Synthèse Expertises.xlsx").Close SaveChanges:=False
            Workbooks("Extract_Expertises.xlsx").Close SaveChanges:=False: Exit Sub

        End If
    End With
    Workbooks("Synthèse Expertises.xlsx").Worksheets("items").Cells.Copy _
    Workbooks("Extract_Expertises.xlsx").Worksheets("synth").Range("A1")  'Copie-colle le fichier
    Workbooks("Synthèse Expertises.xlsx").Close SaveChanges:=False

    With Workbooks("Extract_Expertises.xlsx")
        Worksheets("synth").Columns("A:R").AutoFit
        Columns("M").ColumnWidth = 30
        .SaveAs Filename:=Chemin2 & "\Extract_" & time_backup & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    End With
End Sub