Formula per percentuale

Option Explicit
Sub ritardo()
Dim x
Dim y
y = Range("G2")
For x = 0 To 100 Step 5
  Cells(2, 2) = x
  Cells(2, 7) = y / 100 * x
  Application.Wait (Now + TimeValue("0:00:01"))
  DoEvents
Next x
End Sub

Sub BarP(Progress, TotalSteps, Testo) 'tutt'è due as long inserisce una progressbar
Dim Progress_Char As String
Dim Space_Char As String
Dim Start_Char As String
Dim End_Char As String
Dim CompletedSteps As Long
Dim RemainingSteps As Long

Const MaxWidth = 40
CompletedSteps = Progress / TotalSteps * MaxWidth
RemainingSteps = MaxWidth - CompletedSteps
Start_Char = "[ "
End_Char = " ] "
Progress_Char = "|"  ' [||||  ]
'Progress_Char = ":" ' [::::  ]
Space_Char = " "
Application.StatusBar = Start_Char & WorksheetFunction.Rept(Progress_Char, Round(CompletedSteps, 0)) & _
  WorksheetFunction.Rept(Space_Char, Round(RemainingSteps, 0)) & _
  End_Char & Round(CompletedSteps / MaxWidth * 100, 0) & "% " & Testo
DoEvents
'Se si desidera solo un messaggio e nessun bar animato quindi utilizzare questa linea
' Application.StatusBar = Round (passaggi completati / Max larghezza * 100, 0) e "% Complete"
End Sub

For x = 2 To Ur(Sh7.Name, 7) 
  BarP x, Ur(Sh7.Name, 7), "Scrivo gli ospiti"

'con una semplice dir conti quanti file ci sono nella cartella
Filename = Dir(TuaCartella & "\*.xls*")
Do While Filename <> ""
    Count = Count + 1
    Filename = Dir()
Loop
mLoop = Count '<<<<<<<<<<<<<<<<<<<<<<<<<<

'CICLO LETURA A APERTURA FILES (anche con Dir o, meglio con _
' CreateObject("Scripting.FileSystemObject")


for each file......
     i = i + 1
    apri file.....
    fai quello che devi fare
    
    
    Increment = i / mLoop
    BarWidth = PrBarW * Increment
    ProgrPerc = Round(Increment * 100, 0)
    ProgressUF.bar.Width = BarWidth
    ProgressUF.Border.Caption = ProgrPerc & "% Complete"
    DoEvents
    chiudi il file

Next