Este fórum está sendo desativado

[Pegorini]

Senhores não estou conseguindo resolver um problema.

Na pasta de trabalho no anexo ela registra a data e hora do acesso. A macro insere a informação na próxima linha vazia, mas quando tenho aplicar a lógica quando o usuário sai para fazer o mesmo registro a macro subscreve a informação da linha preenchida, isto é, não faz o registro na linha subsequente.

Alguém conseguiria me informar onde está o erro para que a lógica do registro da entrada seja o mesmo da saída?


Private Sub Workbook_Open()
' Registrar entrada do usuário
With Sheets("Login")
' Encontrar a última linha preenchida na coluna B a partir da linha 2
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
If lastRow < 2 Then lastRow = 2 ' Se a última linha for menor que 2, ajustar para 2
' Registra o usuário como "ADM"
.Cells(lastRow, "A").Value = "ADM"
' Registra a data e hora de entrada
.Cells(lastRow, "B").Value = Format(Date, "dd/mm/yyyy") ' Formata a data para "dd/mm/yyyy"
.Cells(lastRow, "C").Value = Format(Now, "hh:mm:ss")
End With
End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Dim lastEntryRow As Long
Dim nextRow As Long

' Definir a planilha
Set ws = ThisWorkbook.Sheets("Login")

' Encontrar a última linha preenchida na coluna D
lastEntryRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

' Verificar se a próxima linha está vazia ou já contém uma entrada de saída
If ws.Cells(lastEntryRow + 1, "D").Value = "" Or ws.Cells(lastEntryRow + 1, "E").Value <> "" Then
' Se sim, adicionamos uma nova linha para o registro de saída
nextRow = lastEntryRow + 1
Else
' Se não, usamos a próxima linha para o registro de saída
nextRow = lastEntryRow + 1
End If

' Registra a data e hora de saída
ws.Cells(nextRow, "D").Value = Format(Date, "dd/mm/yyyy") ' Formata a data para "dd/mm/yyyy"
ws.Cells(nextRow, "E").Value = Format(Now, "hh:mm:ss")
End Sub

[osvaldomp]

Para não sobrescrever o registro, no código Sub Workbook_BeforeClose, substitua conforme abaixo.

no lugar destas linhas
' ' Encontrar a última linha preenchida na coluna D
' lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

' ' Se a última linha for menor que 2, definir a linha 2 como a próxima linha disponível
' If lastRow < 2 Then
' lastRow = 2
' End If

' ' Registrar o fechamento na linha 2
' Set emptyCell = ws.Cells(lastRow, "D")
' emptyCell.Value = Date
' emptyCell.Offset(0, 1).Value = Format(Now, "hh:mm:ss")

-----------------------------------------------------------------------------------------------------------------------------------------------------------

coloque as linhas abaixo
' Encontrar a última linha preenchida na coluna A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
If lastRow < 2 Then Exit Sub
' Registrar o fechamento
ws.Cells(lastRow, "D") = Date
ws.Cells(lastRow, "E") = Format(Time, "hh:mm:ss")
'sugiro que você acrescente o comando abaixo para salvar o arquivo
ActiveWorkbook.Save

[Pegorini]

Obrigado mais uma vez Osvaldo.