Crear una falsa barra de progreso

[Benito Bartolomé]

Hola a todos y todas;

Estoy intentado crear una falsa barra de progreso vinculada con el campo fecha e una tabla.

El objetivo es que una vez alcanzado el último día del año nos avise de la necesidad de crear una copia de seguridad.

Adjunto un modelo explicativo sobre el que estoy trabajando.

 

Saludos.

MProgreso.xlsm

[JSDJSD]

Según entendí esto podría ser una posible solución.

Private Sub UserForm_Initialize()

Dim Contador As Integer, Maximo As Integer, Intervalo As Integer
Dim Inicio As Double
Dim X As Integer
Dim uf As Integer
Dim vValor As String
Dim vfano As Date

uf = Hoja10.Cells(Rows.Count, 1).End(xlUp).Row
vValor = Month(Hoja10.Cells(uf, 2))
vfano = "31/12/2021"
Me.btnCS.Visible = False
Select Case vValor

    Case 1
        Maximo = 25
    Case 2
        Maximo = 50
    Case 3
        Maximo = 75
    Case 4
        Maximo = 100
    Case 5
        Maximo = 125
    Case 6
        Maximo = 150
    Case 7
        Maximo = 175
    Case 8
        Maximo = 200
    Case 9
        Maximo = 225
    Case 10
        Maximo = 250
    Case 11
        Maximo = 275
    Case Else
        If CDate(Hoja10.Cells(uf, 2)) = CDate(vfano) Then
            Maximo = 300
            Me.btnCS.Visible = True
        End If
End Select

Me.Show
    For Contador = 1 To Maximo
            Inicio = Timer
                Do Until Timer - Inicio > Intervalo
                    X = DoEvents()
                Loop
                Me.lbl_Bar.Width = Contador
                Me.lbl_Porcentaje.Caption = "Cargando " & Format(Contador / Maximo, "Percent")
    Next Contador


End Sub

 

[JSDJSD]

Algo más simplificado

Dim Contador As Integer, Maximo As Integer, Intervalo As Integer
Dim Inicio As Double
Dim X As Integer
Dim uf As Integer

uf = Hoja10.Cells(Rows.Count, 1).End(xlUp).Row
Maximo = Month(Hoja10.Cells(uf, 2)) * 25
Me.btnCS.Visible = False

Me.Show
    For Contador = 1 To Maximo
            Inicio = Timer
                Do Until Timer - Inicio > Intervalo
                    X = DoEvents()
                Loop
                Me.lbl_Bar.Width = Contador
                Me.lbl_Porcentaje.Caption = "Cargando " & Format(Contador / (Maximo), "Percent")
    Next Contador
If Maximo = 300 Then Me.btnCS.Visible = True


End Sub

 

[Benito Bartolomé]

Hace 6 minutos , JSDJSD dijo:

Algo más simplificado

Dim Contador As Integer, Maximo As Integer, Intervalo As Integer
Dim Inicio As Double
Dim X As Integer
Dim uf As Integer

uf = Hoja10.Cells(Rows.Count, 1).End(xlUp).Row
Maximo = Month(Hoja10.Cells(uf, 2)) * 25
Me.btnCS.Visible = False

Me.Show
    For Contador = 1 To Maximo
            Inicio = Timer
                Do Until Timer - Inicio > Intervalo
                    X = DoEvents()
                Loop
                Me.lbl_Bar.Width = Contador
                Me.lbl_Porcentaje.Caption = "Cargando " & Format(Contador / (Maximo), "Percent")
    Next Contador
If Maximo = 300 Then Me.btnCS.Visible = True


End Sub

 

Hola y muchas gracias por su respuesta JSDJSD.

Están casi bien las dos.

Hay un pequeño error.

En la primera macro al poner cualquier día del mes de diciembre se para, adjunto imagen:

En la segunda no pasa pero si pongo 30/12 no debería mostrar el botón "btnCS". En la imagen he puesto el día 20 pero inclusive con el día 1 ya pone al botón visible y este

solo debe aparecer el 31/12.

Si puedes ajustar un pelín más sería perfecto, en cualquier caso agradezco tú tiempo y esfuerzo.

Un saludo. 

[JSDJSD]

Prueba ahora 

Private Sub UserForm_Initialize()

Dim Contador As Integer, Maximo As Integer, Intervalo As Integer
Dim Inicio As Double
Dim X As Integer
Dim uf As Integer

uf = Hoja10.Cells(Rows.Count, 1).End(xlUp).Row
Maximo = Month(Hoja10.Cells(uf, 2)) * 25
Me.btnCS.Visible = False

Me.Show
    For Contador = 1 To Maximo
            Inicio = Timer
                Do Until Timer - Inicio > Intervalo
                    X = DoEvents()
                Loop
                Me.lbl_Bar.Width = Contador
                Me.lbl_Porcentaje.Caption = "Cargando " & Format(Contador / (Maximo), "Percent")
    Next Contador
If Maximo = 300 And Hoja10.Cells(uf, 2) = "31/12/2021" Then Me.btnCS.Visible = True


End Sub

 

[Benito Bartolomé]

Hace 1 hora, JSDJSD dijo:

Prueba ahora 

Private Sub UserForm_Initialize()

Dim Contador As Integer, Maximo As Integer, Intervalo As Integer
Dim Inicio As Double
Dim X As Integer
Dim uf As Integer

uf = Hoja10.Cells(Rows.Count, 1).End(xlUp).Row
Maximo = Month(Hoja10.Cells(uf, 2)) * 25
Me.btnCS.Visible = False

Me.Show
    For Contador = 1 To Maximo
            Inicio = Timer
                Do Until Timer - Inicio > Intervalo
                    X = DoEvents()
                Loop
                Me.lbl_Bar.Width = Contador
                Me.lbl_Porcentaje.Caption = "Cargando " & Format(Contador / (Maximo), "Percent")
    Next Contador
If Maximo = 300 And Hoja10.Cells(uf, 2) = "31/12/2021" Then Me.btnCS.Visible = True


End Sub

 

Hola de nuevo JSDJSD,  disculpa la tardanza,  ahora si va bien. 

Muchísimas gracias y hasta la próxima. 

Saludos ? ?