Microsoft 365 ProgressBar dans traitement fichiers

Dim CheminInitial$, fso As Object, Nmax&, n&, L#, NouveauNom$ 'mémorise les variables

Sub Lancer()
CheminInitial = ThisWorkbook.Path
Set fso = CreateObject("Scripting.FileSystemObject")
Nmax = 0
n = 0
L = Feuil1.OLEObjects("Label1").Width
Feuil1.OLEObjects("Label2").Width = 0
Feuil1.Range("C2") = "0% des fichiers sont renommés"
NouveauNom = "Mon beau fichier " '"Classeur" 'à adapter
Compte CheminInitial
Renomme CheminInitial
End Sub

Sub Compte(chemin$)
Dim sf As Object
For Each sf In fso.GetFolder(chemin).subfolders
    Compte sf.Path 'récursivité pour traiter l'arborescence
    Nmax = Nmax + sf.Files.Count
Next sf
End Sub

Sub Renomme(chemin$)
Dim sf As Object, f As Object, numero&, extension$
For Each sf In fso.GetFolder(chemin).subfolders
    Renomme sf.Path 'récursivité pour traiter l'arborescence
    numero = 0
    For Each f In sf.Files
        If Not f.Name Like NouveauNom & "*" Then
            '--renomme le fichier (à adapter)---
            numero = numero + 1
            extension = Mid(f.Name, InStrRev(f.Name, "."))
            Name f.Path As sf.Path & "\" & NouveauNom & Format(numero, "0000") & extension
            '---barre de progression---
            n = n + 1
            Feuil1.OLEObjects("Label2").Width = L * n / Nmax
            Feuil1.Range("C2") = Format(n / Nmax, "0%") & " des fichiers sont renommés"
            Application.ScreenUpdating = True
        End If
Next f, sf
End Sub