Olá a todos,
Tenho um projecto em excel que está em funcionamento na empresa, num tablet windows. Tenho vindo a aprimorar alguns pormenores ao longo do tempo. Agora, gostaria de colocar uma barra de progresso/status quando é executada determinada macro. Devido ao facto de estar a funcionar no tablet a execução desta macro é um pouco lenta. Já vi na net vários exemplos inclusivamente aqui no planilhando, mas infelizmente não consigo adaptar ao meu projecto. Segue a macro em questão. Agradece desde já a vossa disponibilidade e ajuda, tem sido importante.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
Application.DisplayFormulaBar = True
ActiveWindow.DisplayHeadings = True
End Sub
Private Sub Workbook_Open()
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
Application.DisplayStatusBar = False
End Sub
Sub Gravar()
Dim Data As Date
Dim Funcionario As String
Dim Obra As String
Dim Cliente As String
Dim HorasTotais As Double
Dim HorasExtras As Double
Dim UltimaCel As Integer
Dim RespostaConfirmaçãoAZero As Integer
Dim ConfirmaçãoRepetida As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("G16") = 1 Then
ConfirmaçãoRepetida = MsgBox("Já foram inseridas as horas para este funcionario na data de hoje, deseja prosseguir?", _
vbYesNo + vbQuestion, "Confirmação de gravação de Horas")
If ConfirmaçãoRepetida = vbNo Then
MsgBox "Caso queira inserir horas de outro dia em falta, escreva o dia no campo Tarefa/Outras Anotações.", vbOKOnly + vbInformation, "Informação"
Exit Sub
End If
End If
Data = Range("G3").Value
Funcionario = Range("B5").Value
Obra = Range("B9").Value
Cliente = Range("B7").Value
HorasTotais = Range("C11").Value
If Range("c11") = 0 Then
RespostaConfirmaçãoAZero = MsgBox("Confirmar as Horas Totais de Hoje a 0 (zero)?", vbYesNo + vbQuestion, "Confirmação")
If RespostaConfirmaçãoAZero = vbNo Then
MsgBox "Insira as horas correctamente!", vbOKOnly + vbExclamation, "Correcção de Horas"
Exit Sub
End If
End If
HorasExtras = Range("C13").Value
Sheets("Registo de Ponto Diário").Activate
UltimaCel = Range("A1000000").End(xlUp).Row + 1
Range("A" & UltimaCel).Value = Data
Range("B" & UltimaCel).Value = Funcionario
Range("C" & UltimaCel).Value = Obra
Range("D" & UltimaCel).Value = Cliente
Range("E" & UltimaCel).Value = HorasTotais
Range("F" & UltimaCel).Value = HorasExtras
Sheets("Relógio de Ponto").Activate
Range("B9").Value = ""
Range("C11").Value = ""
ActiveWorkbook.Save
MsgBox "Gravado com Sucesso!", vbOKOnly + vbInformation, "Gravação de Dados"
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Postado : 13/05/2016 4:09 am