Macro para Gravar Usuário da Rede que Fez Alteração na Plan

2024 - VBA & Macros

Post Recente por nicolas314 9 anos atrás

5 Posts

4 Usuários

0 Reactions

1,685 Visualizações

RSS

nicolas314

(@nicolas314)

Posts: 6

Active Member

Topic starter

Pessoal, tudo bem?

Trabalho em uma empresa que possui unidades de atendimento e cada uma tem uma planilha onde são realizados os pedidos de insumos.
Os pedidos tem dia certo e limite de horário para serem feitos.

Andei tendo alguns problemas do tipo: "Fiz o pedido e não recebi o produto" (Na verdade a pessoa fez o pedido fora do horário estipulado)

Resumindo:

Encontrei uma macro para gravar a aba que foi feita alteração, bem como o usuário de rede e a data! Tudo lindo, só que não.
Essa macro grava as alterações que são feitas em todas as abas da planilhas, mas eu preciso que ela grave somente o que foi alterado na aba "Registro".

Segue o código:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim LR As Long
If Sh.Name = "DedoDuro" Then Exit Sub
Application.EnableEvents = False
With Sheets("DedoDuro")
LR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A" & LR + 1).Value = Format(Now, "dd-mm-yy hh:mm:ss")
.Range("B" & LR + 1).Value = Sh.Name
'.Range("C" & LR + 1).Value = Target.Address(False, False) 'Não uso essa linha.
'.Range("D" & LR + 1).Value = Target.Value 'Não uso essa linha.
.Range("C" & LR + 1).Value = Environ("USERNAME")
End With
Application.EnableEvents = True
End Sub

Desde já, agradeço!!

Postado : 29/01/2016 8:11 am

MPrudencio

(@mprudencio)

Posts: 2749

Famed Member

O ideal seria disponibilizar o arquivo como modelo para que a macro seja feita de acordo com o arquivo.

Mas de Qualquer maneira essa macro registra numa planilha de nome Dedo Duro a data, o usuario do micro, e o horario que isso foi feito.

Vc pode ocultar a planilha pelo VBA para que o usuario nao tenha acesso.

Segue o codigo


Sub RegistraUsuario()

Dim WR As Worksheet
Dim WDD As Worksheet
Dim WDDULinha As Long

Set WR = Sheets("Registro")
Set WDD = Sheets("Dedo Duro")
WDDULinha = WDD.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row

WDD.Cells(WDDULinha, 1) = Date
WDD.Cells(WDDULinha, 2) = Environ("UserName")
WDD.Cells(WDDULinha, 3) = Time

End Sub

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 29/01/2016 9:25 am

Fernando Fernandes

(@fernandofernandes)

Posts: 43750

Illustrious Member

Boa tarde Nicolas,

Segue minha contribuição:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim wsDedoDuro  As Worksheet
Dim Dedurar     As String
Dim Indice      As Long

    Dedurar = "Registro,Registro2" ' Insira aqui o nome das planilhas que deseja derurar

    If InStr(1, Dedurar, ThisWorkbook.ActiveSheet.Name) = 0 Then Exit Sub
    Set wsDedoDuro = ThisWorkbook.Worksheets("DedoDuro")
    
    Application.EnableEvents = False
    Indice = wsDedoDuro.Cells(Rows.Count, 1).End(xlUp).Row
    wsDedoDuro.Cells(Indice + 1, 1).Value = Sh.Name
    wsDedoDuro.Cells(Indice + 1, 2).Value = Format(Now, "dd-mm-yy hh:mm:ss")
    wsDedoDuro.Cells(Indice + 1, 3).Value = Environ("USERNAME")
    wsDedoDuro.Cells(Indice + 1, 4).Value = Target.Address(False, False)
    wsDedoDuro.Cells(Indice + 1, 5).Value = Target.Value
    Application.EnableEvents = True
    
    Set wsDedoDuro = Nothing
    
End Sub

Qualquer coisa da o grito.
Abraço

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 29/01/2016 11:04 am