Barra de progreso cuando se ejecuta un macro al abrir el libro
Para Dante Amor: tengo una macro que se ejecuta cuando abro el libro, "Private Sub Workbook_Open()" quisiera colocarle una barra de progreso o bien un cuadro de dialogo tipo" espere actualizando datos" y luego que finalice. He visto en este foro sobre barras de progresos pero no cuando el macro es con un workbook_open.
1 Respuesta
Respuesta de Dante Amor
1
Envíame tu archivo para revisar cómo poner la barra de progreso.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Nicolas Koroll” y el título de esta pregunta.
¡Gracias! Ya te lo envíe, pero se me paso poner en el asunto el titulo de la pregunta "Barra de progreso cuando se ejecuta un macro al abrir el libro"
Te anexo el código del formulario
Private Sub UserForm_Activate()
'Referencia: http://support.microsoft.com/kb/211736/es
'Mod.Por.Dante Amor
LProgress.Width = 0
Call Principal
End Sub
'
Sub Principal()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("Acción").Select
rep = 1
Label1 = "Procesando ..."
Label1.BorderStyle = 0
'
fin = Range("L" & Rows.Count).End(xlUp).Row
correo = "correo"
passwd = "pwd"
Dim Email As CDO.Message
For i = 1 To fin
'***
'
If Cells(i, "M") <> "enviado" Then
Set Email = New CDO.Message
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = Cells(i, "L")
.From = correo
.Subject = Cells(i, "B")
.TextBody = Cells(i, "T")
.Configuration.Fields.Update
On Error Resume Next
.Send
If Err.Number = 0 Then
Cells(i, "M") = "enviado"
Else
Cells(i, "M") = ""
End If
End With
Set Email = Nothing
End If
'
'***
avance = (i * 100) / fin
If Int(avance) = rep Then
UpdateProgressBar rep
rep = rep + 1
End If
Next
Application.ScreenUpdating = True
Label1 = "Proceso Terminado"
CommandButton1.Visible = True
Application.EnableEvents = True
End Sub
'
Sub UpdateProgressBar(ava)
'Por.Dante Amor
UserFormBar.Frame1.Caption = Format(ava / 100, "0%")
UserFormBar.LProgress.Width = UserFormBar.LProgress.Width + 3
DoEvents
End Sub
'
Private Sub CommandButton1_Click()
Unload Me
End Sub
'
sal u dos
