Barra de progreso

Hola, alguien me podría decir por favor que debo poner en esta macro para que mientras se ejecuta me salga una barra de progreso en el centro de la pantalla,
gracias.-
Sub BOTON252IB()
'
' BOTON252IB Macro
' Macro grabada el 29/11/2008 por
'
If vbYes = MsgBox("¡ IMPORTANTE !" & vbCr & "VA HA PROCEDER A FIGURAR UNA VISITA AL VEHICULO" & vbCr & "ASI COMO MODIFICAR LOS KILOMTROS" & vbCr & "PULSE (SI) PARA CONTINUAR O (NO) PARA SALIR Y NO MODIFICAR", 48 + 4 + 256, "ATENCION") Then
ActiveSheet.Unprotect "C"
Range("C" + CStr(ActiveCell.Row)).Select
'
Selection.Copy
ActiveCell.Offset(0, 8).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, -6).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, 6).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -6).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
If vbYes = MsgBox("MODIFICACION REALIZADA", 32 + 0 + 256, "NOTA INFORMATIVA") Then
End If
ActiveSheet.Protect "C"
End If
ThisWorkbook.Save ' Con esta Instruccion Guardas todo.
End Sub

1 Respuesta

Respuesta
1
No entiendo que quieres hacer la macro funciona correctamente que quieres mostrar mientras se ejecuta, házmelo entender.
Hola. Gracias por responder veras me gustaría que después de aceptar que se va a ejecutar cambios saliera una barra de progreso con un porcentaje de 0 a 100% de que se están realizando los cambios y después de aceptar en el segundo cuadro de texto o msbox saliera otra barra de progreso indicando que se esta guardando el archivo ambos cuadros de progreso (Pobressbar) en el centro de pantalla. Pero no se como ponerlo en la macro o si hay que ponerlo en el código de la hoja
Espero tu ayuda
Gracias.
Ejecuta tu macro así:
userform1.show
todo el codigo del macro
Private Sub UserForm_Activate()
Dim x As Long
' Generamos un ciclo For
For x = ProgressBar1.Min To ProgressBar1.Max
' Mostramos la veriable x (el value) en Label1
Label1 = x
' Usamos DoEvents para poder visualizar el conteo en el Label
DoEvents
' Asignamos en la propiedad Value del control ProgressBar _
el valor de x para ir incrementando la barra de progreso

ProgressBar1.Value = x
Next x
Unload USerform1
End Sub
Private Sub Form_Load()
'Le asignamos las propiedades para el mínimo, máximo valor del Progress bar
With ProgressBar1
.Max = 5000
.Min = 0
.Value = 0
End With
End Sub
Pruébalo y me contestas Un saludo
Julio
Hola, Julio he puesto así la macro y se me para te pongo a continuación el código que ejecuta la macro ten encuenta que la misma se ejecuta cuando me pongo encima de una determinada celda y tengo algún valor veras en el código de la hoja pongo esto para que cuando me pongo encima de la celda que pone IB se ejecute la macro:
1º hoja con código para que se ejecute la macro siguiente
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Offset(0, 1).Value = "" Or Target.Offset(0, 1).Value = 0 Then Exit Sub
If Target.Column = 2 Then 'actua sobre la col C
Select Case Target.Value
Case Is = "IS"
Call BOTON252IS
Case Is = "IB"
Call BOTON252IB
Case Is = "I1"
Call BOTON252I1
Case Is = "I2"
Call BOTON252I2
Case Is = "I3"
Call BOTON252I3
Case Is = "US"
Call BOTON252US
Case Is = "I3"
Call BOTON252I3
Case Is = "RB1"
Call BOTON252RB1
Case Is = "I4"
Call BOTON252I4
Case Is = "RS"
Call BOTON252RS
Case Is = "RB2"
Call BOTON252RB2
Case Is = "RC"
Call BOTON252RC
Case Is = "IGR"
Call BOTON252IGR
End Select
End If
End Sub
2ª la macro con tu modificacion

UserForm1.Show
'todo el codigo del macro
Sub BOTON252IB()
End Sub
' BOTON252IB Macro
' Macro grabada el 29/11/2008 por
'
If vbYes = MsgBox("¡ IMPORTANTE !" & vbCr & "VA HA PROCEDER A FIGURAR UNA VISITA AL VEHICULO" & vbCr & "ASI COMO MODIFICAR LOS KILOMTROS" & vbCr & "PULSE (SI) PARA CONTINUAR O (NO) PARA SALIR Y NO MODIFICAR", 48 + 4 + 256, "ATENCION") Then
ActiveSheet.Unprotect "CALABAZA269"
Range("C" + CStr(ActiveCell.Row)).Select
'
Selection.Copy
ActiveCell.Offset(0, 8).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -2).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(1, -6).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, 6).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(0, -6).Range("A1").Select
Application.CutCopyMode = False
Selection.ClearContents
If vbYes = MsgBox("MODIFICACION REALIZADA", 32 + 0 + 256, "NOTA INFORMATIVA") Then
End If
ActiveSheet.Protect "CALABAZA269"
End If
ThisWorkbook.Save ' Con esta Instruccion Guardas todo.
Private Sub UserForm_Activate()
Dim x As Long
' Generamos un ciclo For
For x = ProgressBar1.Min To ProgressBar1.Max
' Mostramos la veriable x (el value) en Label1
Label1 = x
' Usamos DoEvents para poder visualizar el conteo en el Label
DoEvents
' Asignamos en la propiedad Value del control ProgressBar _
el valor de x para ir incrementando la barra de progreso
ProgressBar1.Value = x
Next x
Unload UserForm1
End Sub
Private Sub Form_Load()
'Le asignamos las propiedades para el mínimo, máximo valor del Progress bar
With ProgressBar1
.Max = 5000
.Min = 0
.Value = 0
End With
End Sub
No se Julio en donde esta el fallo
Gracias. Un saludo Antonio
Veo que conoces código de macros para que te funcione el spacebar, dame tu correo y te mando un excel con todos los códigos así los tendrás y los aplicas donde tu quieras
[email protected]
Gracias Julio
Ya te contare.
Ya te he enviado el archivo ya me contarás si te ha servido.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas