Logning af ændringer

Logning af ændringer i regneark, nem implementering

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 er kompatibelt med både 32 og 64 bit version af Excel.
 
Scriptet kan modificeres i mange retninger, men som standard logges følgende:
 

  1. Hvornår er filen åbnet (dato klokkeslæt)
  2. Hvem har åbnet filen (brugernavn på den bruger som er logget ind)
  3. Hvor var filen placeret da den blev åbnet
  4. Hvornår er filen gemt (dato klokkeslæt)
  5. Hvem har gemt filen (brugernavn på den bruger som er logget ind)
  6. Hvornår er filen lukket (dato klokkeslæt)
  7. Hvem har lukket filen ((brugernavn på den bruger som er logget ind)
  8. Hvor var filen placeret da den blev lukket
  9. Hvornår er det sidst udskrevet på printeren (dato klokkeslæt)
  10. Hvem har udskrevet regnearket på printeren  (brugernavn på den bruger som er logget ind)
  11. Er der ændret i filen (dato klokkeslæt og før/efter værdi)
  12. Hvem har ændret i filen (brugernavn på den bruger som er logget ind)
  13. Hvor har brugeren ændret i filen (arknavn og adressen på cellen)
  14. Hvad har brugeren ændret i filen (før værdi / formel, og til værdi / formel)
  15. Hvilke faner brugeren har aktiveret og dermed har set.

Ud over dette, kan du også bestemme hvor logfilen skal placeres, om den skal være skrivebeskyttet og/eller skjult.

 

Logningen sker i en lille tekstfil, navngivet med filens navn og "_brugere.log". Som standard er logfilen placeret i samme mappe som den fil du logger.
Filen oprettes automatisk.

Logfilen ser således ud

Logning af ændringer i Excel

 

Implementering af loggen i dit regneark er meget simpel:

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

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

'***Copyright Allan Thustrup Mortensen - Excel-regneark.dk ***
'*************************************************************
Option Explicit
Private Const LogFilNavn = "brugere.log" 'Logfilen navngives som standard: filnavn_brugere.log
Private Const LogFilPlacering = "" 'Hvis tom, gemmes i samme mappe som moderfilen, ellers HUSK at afslutte stien med backslash
Private Const Gem = True 'Skal 'gem' indgå i logfilen
Private Const Åben = True  'Skal 'åben' indgå i logfilen
Private Const Luk = True  'Skal 'luk' indgå i logfilen
Private Const Udskriv = True  'Skal 'udskriv' indgå i logfilen
Private Const Ændring_i_Celle = True  'Skal ændringer i cellers tekst eller værdier indgå i logfilen
Private Const Ændring_i_Formel = True  'Skal ændringer i formler indgå i logfilen
Private Const AktiveFane = True  'Skal faneskift indgå i logfilen
Private Const OutputFormat_txt = False 'Tid og datofelter skal logges i deres oprindelige format.
Private Const SkjulLogfil = False 'Sæt denne til 'True' hvis du ønsker at markere logfilen som skjult i filsystemet
Private Const SkrivebeskytLogfil = False 'Sæt denne til 'True' hvis du ønsker at skrivebeskytte logfilen
'*************************************************************

Public GammelVærdi As Variant
Public GammelFormel As Variant
Public HarFormel As Boolean

#If Win64 Then
   Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#Else
   Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
#End If

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Gem = True Then
    On Error Resume Next
    Call SetFilegenskaber(False)
    If LogFilPlacering = "" Then
        Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    Else
        Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    End If
    Print #1, Brugernavn, "LUK", Now, ThisWorkbook.FullName
    Close #1
    Call SetFilegenskaber(True)
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Udskriv = True Then
    On Error Resume Next
    Call SetFilegenskaber(False)
    If LogFilPlacering = "" Then
        Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    Else
        Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    End If
    Print #1, Brugernavn, "Udskriv", Now
    Close #1
    Call SetFilegenskaber(True)
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
        Call SetFilegenskaber(False)
        If LogFilPlacering = "" Then
            Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
        Else
            Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
        End If
        Print #1, Brugernavn, "GEM", Now
        Close #1
    End If
    Call SetFilegenskaber(True)
End If
End Sub
Private Sub Workbook_Open()
If Åben = True Then
    On Error Resume Next
    Call SetFilegenskaber(False)
    If LogFilPlacering = "" Then
        Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    Else
        Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    End If
    Print #1, Brugernavn, "ÅBEN", Now, ThisWorkbook.FullName
    Close #1
    Call SetFilegenskaber(True)
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
On Error Resume Next
If AktiveFane = True Then
    Call SetFilegenskaber(False)
    If LogFilPlacering = "" Then
        Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    Else
        Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    End If
    Print #1, Brugernavn, "Aktiv fane ", Now, Sh.Name
    Close #1
    Call SetFilegenskaber(True)
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
    Call SetFilegenskaber(False)
    If LogFilPlacering = "" Then
        Open ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    Else
        Open LogFilPlacering & ThisWorkbook.Name & "_" & LogFilNavn For Append As #1
    End If
    If Ændring_i_Formel = True Then
        If Target.HasFormula Then
            If HarFormel = True And Target.FormulaLocal <> GammelFormel Then Print #1, Brugernavn, "Ændring", Now, ActiveSheet.Name & " " & Target.Address(False, False), "Fra: " & GammelFormel, "Til: " & Target.FormulaLocal
            If HarFormel = False Then Print #1, Brugernavn, "Ændring", Now, ActiveSheet.Name & " " & Target.Address(False, False), "Fra: " & GammelVærdi, "Til: " & Target.FormulaLocal
        Else
            If HarFormel = True Then Print #1, Brugernavn, "Ændring", Now, ActiveSheet.Name & " " & Target.Address(False, False), "Fra: " & GammelFormel, "Til: " & Target.Value
        End If
    End If
    If OutputFormat_txt = True Then
        If Target.Text <> GammelVærdi Then Print #1, Brugernavn, "Ændring", Now, ActiveSheet.Name & " " & Target.Address(False, False), "Fra: " & GammelVærdi, "Til: " & Target.Text
    Else
        If Target.Value <> GammelVærdi Then Print #1, Brugernavn, "Ændring", Now, ActiveSheet.Name & " " & Target.Address(False, False), "Fra: " & GammelVærdi, "Til: " & Target.Value
    End If
    Close #1
    Call SetFilegenskaber(True)
End If
Set GammelVærdi = Nothing
Set GammelFormel = Nothing
HarFormel = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If ActiveCell.Address <> Target.Address Then Exit Sub
Call SetFilegenskaber(False)
If OutputFormat_txt = True Then
    If Target.HasFormula Then
        HarFormel = True
        If Ændring_i_Formel = True Then
            GammelFormel = Target.FormulaLocal
            GammelVærdi = Target.Text
        Else
            GammelVærdi = Target.Text
        End If
    Else
        GammelVærdi = Target.Value
    End If
Else
    If Target.HasFormula Then
        HarFormel = True
        If Ændring_i_Formel = True Then
            GammelFormel = Target.FormulaLocal
            GammelVærdi = Target.Value
        Else
            GammelVærdi = Target.Value
        End If
    Else
        GammelVærdi = Target.Value
    End If
End If
Call SetFilegenskaber(True)
End Sub
Private Sub SetFilegenskaber(Switch As Boolean)
Dim LogSti As String
Dim FSO As Object
Set FSO = CreateObject("scripting.filesystemobject")
If LogFilPlacering = "" Then
    LogSti = ThisWorkbook.Path & Application.PathSeparator & ThisWorkbook.Name
Else
    LogSti = LogFilPlacering
End If
 If FSO.FileExists(LogSti & "_" & LogFilNavn) = True Then
    If Switch = False Then
        SetAttr LogSti & "_" & LogFilNavn, 0
    End If
    If Switch = True Then
        If SkjulLogfil = True And SkrivebeskytLogfil = True Then SetAttr LogSti & "_" & LogFilNavn, 1 + 2
        If SkjulLogfil = False And SkrivebeskytLogfil = True Then SetAttr LogSti & "_" & LogFilNavn, 1
        If SkjulLogfil = True And SkrivebeskytLogfil = False Then SetAttr LogSti & "_" & LogFilNavn, 2
    End If
End If
Set FSO = Nothing
End Sub
Function Brugernavn() As String
Application.Volatile
Dim Buffer As String * 100
Dim BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
Brugernavn = LCase(Left(Buffer, BuffLen - 1))
End Function


 

Maintenance