Como hacer una barra de progreso incluida en un formulario que me diga en que por ciento...

Puedes poner aquí tu código completo de ese "procedimiento de borrar", para ver si puedo mejorar el código y sea más rápido.

Saludos Dante a continuación te envío el código,.

Los problemas que me dan son:

Se ejecuta el PROGRESS BAR CODES muy rápido y no tiene ninguna relación con la ejecución de borrar y por supuesto me gustaría ver el por ciento de ejecución del borrado de la hoja

Gracias

Eusebio

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Pass = "chevo"
Sheets("MKP").Unprotect "chevo"
If ListBox1.ListIndex >= 0 Then
cevap = MsgBox("Eintrag wird gelöscht. ... Sind Sie sicher ?", vbYesNo, "")
End If

Call Main 'Progress Bar
MsgBox "Die Daten werden gelöscht, Bitte haben etwas Geduld", vbApplicationModal, ""
Sheets("MKP").Range("A2:F10000,G2:M10000,O2:AD10000,DS2:DS10000,Ay2:BH10000,DB2:DH10000,Dj2:DQ10000,AO2:AS10000,DU2:DY10000,EE2:EE10000,EH2.EL10000,FS2.FS10000,FW2:FW10000").ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub

PROGRESS BAR CODES
Sub Main()
Dim I, tot As Integer
tot = 5000
For I = 1 To tot
If I Mod 5 = 0 Then
ProgressBar I / tot
End If
Next I
lblDone.Width = 0
lblPct.Visible = False
End Sub

Sub ProgressBar(PctDone As Single)
lblDone.Width = PctDone * (lblRemain.Width - 2)
lblPct.Visible = True
lblPct.Caption = Format(PctDone, "0%")
DoEvents
End Sub

Vamos Eusebio!, después de varias preguntas, supongo que ya sabes que el código se debe insertar con el icono para código.

Espero que en las siguientes preguntas puedas poner el código con el botón. De esa manera es más fácil copiarlo y leerlo.

Información adicional, ¿cuántos registros tienes que procesar y cuánto tiempo tarda tu macro?

Tu macro solamente hace esto:

 Sheets("MKP"). Range("A2:F10000, G2:M10000, O2:AD10000, DS2:DS10000, Ay2:BH10000, DB2:DH10000, Dj2:DQ10000, AO2:AS10000, DU2:DY10000, EE2:EE10000, EH2.EL10000, FS2.FS10000, FW2:FW10000"). ClearContents

'

¿Y cuánto tiempo se tarda en limpiar esas celdas?

Se tarda 1 min y 33 Segundos y borra 179 Columnas y 10000 Filas

No entiendo por qué tarda tanto en limpiar las celdas, en una prueba que hice el resultado es inmediato. Pero le hice cambios al código para mostrar el avance en la barra de progreso.

Reemplaza tu código por el siguiente:

Private Sub CommandButton3_Click()
  Dim arr As Variant, i As Long
  Dim pass As String, cevap As Variant
  '
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  ActiveSheet.DisplayPageBreaks = False
  '
  pass = "chevo"
  Sheets("MKP").Unprotect "chevo"
  If ListBox1.ListIndex >= 0 Then
    cevap = MsgBox("Eintrag wird gelöscht. ... Sind Sie sicher ?", vbYesNo, "")
  End If
  '
  MsgBox "Die Daten werden gelöscht, Bitte haben etwas Geduld", vbApplicationModal, ""
  '
  arr = Array("A2:F10000", "G2:M10000", "O2:AD10000", "DS2:DS10000", _
              "Ay2:BH10000", "DB2:DH10000", "Dj2:DQ10000", "AO2:AS10000", _
              "DU2:DY10000", "EE2:EE10000", "EH2:EL10000", "FS2:FS10000", _
              "FW2:FW10000")
  For i = 0 To UBound(arr)
    Call ProgressBar(i / UBound(arr))  'Progress Bar
    Sheets("MKP").Range(arr(i)).ClearContents
  Next
  '
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  ActiveSheet.DisplayPageBreaks = True
  Application.CutCopyMode = False
End Sub
'
Sub ProgressBar(PctDone As Single)
  lblDone.Width = PctDone * (lblRemain.Width - 2)
  lblPct.Visible = True
  lblPct.Caption = Format(PctDone, "0%")
  DoEvents
End Sub

¡Gracias! No da los porcientos pero termino exactamente con la terminación del proceso.

Muchísimas gracias

Eusebio