Logning af ændringer

Log til Excel som logger alle ændringer som er foretaget i dit regneark

Dette lille script, forsyner Excel med en logningsfunktion som er savnet af mange.
Der er tale om en makro, som naturligvis kun kører hvis makroer er slået til i Excel, så brugeren kan, hvis de er kyndige nok, undlade at få logget deres ændringer. Hvis du vil undgå dette, kan Excel-regneark.dk være behjælpelig med en løsning.

Scriptet kan modificeres i mange retninger, men som standard logges følgende:

Hvornår er filen åbnet (dato klokkeslet)
Hvem har åbnet filen (brugernavn på den bruger som er logget ind)
Hvornår er filen gemt (dato klokkeslet)
Hvem har gemt filen (brugernavn på den bruger som er logget ind)
Hvornår er filen lukket (dato klokkeslet)
Hvem har lukket filen ((brugernavn på den bruger som er logget ind)
Hvornår er det sidst udskrevet på printeren (dato klokkeslet)
Hvem har udskrevet regnearket på printeren (brugernavn på den bruger som er logget ind)
Er der ændret i filen (dato klokkeslet)
Hvem har ændret i filen (brugernavn på den bruger som er logget ind)
Hvor har brugeren ændret i filen (arknavn og adressen på cellen)
Hvad har brugeren ændret i filen (Før værdi, til værdi)

Logningen sker i en ekstern tekstfil, ved navn "Brugere.log" som kan placeres hvilket sted på netværket du ønsker, som standard er logfilen placeret ved siden af den fil du logger.
Filen oprettes automatisk.

Logfilen ser således ud

Implementering af loggen i dit regneark er meget simpel:

Kopier alt i kodeboksen herunder
Åben den Excel-fil du vil logge
Hold tasten ALT neden og tryk på F11 for at starte VBA-Editoren
Find din fil på listen til venstre, og find THISWORKBOOK som tilhører din fil, klik på den.
Sæt koden ind i det hvide område til højre.
Gem filen.
Nu er loggen klar til brug.

Alternativt kan du downloade en fil hvor loggen allerede er implementeret, klik her:

'***Copyright Allan Thustrup Mortensen - Excel-regneark.dk ***
'*************************************************************

Private Const LogFilNavn = "Brugere.log"
Private Const Gem = True
Private Const Åben = True
Private Const Luk = True
Private Const Udskriv = True
Private Const Ændring_i_Celle = True

'*************************************************************
Public GammelVærdi As Variant
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_Open()

If Åben = True Then
    On Error Resume Next
    Open ThisWorkbook.Path & Application.PathSeparator & LogFilNavn For Append As #1
        Print #1, UserName, "ÅBEN", Now
        Close #1
End If
End Sub

Function UserName() As String
    Dim Buffer As String * 100
    Dim BuffLen As Long
    BuffLen = 100
    GetUserName Buffer, BuffLen
    UserName = Left(Buffer, BuffLen - 1)
End Function
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Gem = True Then
    On Error Resume Next
    Open ThisWorkbook.Path & Application.PathSeparator & LogFilNavn For Append As #1
        Print #1, UserName, "LUK", Now
        Close #1
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Udskriv = True Then
    On Error Resume Next
    Open ThisWorkbook.Path & Application.PathSeparator & LogFilNavn For Append As #1
        Print #1, UserName, "Udskriv", Now
        Close #1
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Gem = True Then
    On Error Resume Next
    If ThisWorkbook.Saved = False Then
        Open ThisWorkbook.Path & Application.PathSeparator & LogFilNavn For Append As #1
            Print #1, UserName, "GEM", Now
            Close #1
    End If
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Ændring_i_Celle = True Then
    Open ThisWorkbook.Path & Application.PathSeparator & LogFilNavn For Append As #1
        Print #1, UserName, "Ændring", Now, ActiveSheet.Name & " " & Target.AddressLocal, "Fra: " & GammelVærdi, "Til: " & Target.Value
        Close #1
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveCell.Address <> Target.Address Then Exit Sub
GammelVærdi = Target.Value
End Sub

Opdateret 18-06-2010 11:04:35