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:

Hvornår blev filen åbnet (dato klokkeslæt)
Hvem har åbnet filen (brugernavn på den bruger som er logget ind)
Hvor var filen placeret da den blev åbnet
Hvornår blev filen gemt (dato klokkeslæt)
Hvem har gemt filen (brugernavn på den bruger som er logget ind)
Hvor blev filen gemt
Hvornår blev filen lukket (dato klokkeslæt)
Hvem har lukket filen ((brugernavn på den bruger som er logget ind)
Hvor var filen placeret da den blev lukket
Hvornår blev dokumentet udskrevet på printeren (dato klokkeslæt)
Hvem har udskrevet regnearket på printeren (brugernavn på den bruger som er logget ind)
Er der ændret i filen (dato klokkeslæt og før/efter værdi)
Hvem har ændret i filen (brugernavn på den bruger som var logget ind)
Hvor har brugeren ændret i filen (arknavn og adressen på cellen)
Hvad har brugeren ændret i filen (før værdi / formel, og til værdi / formel)
Hvilke faner brugeren har aktiveret og dermed har set.
Har brugeren klikket på et hyperlink i filen og hvilket.

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:

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 hedder 'Denne_projektmappe' i Excel 2010 og nyere) 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 ***
'*************************************************************
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 Klik_Hyperlink = True 'Skal klik på hyperlinks 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_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
On Error Resume Next
If Klik_Hyperlink = True Then
Call SetFilegenskaber(False)
If LogFilPlacering = vbNullString 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 ekstern ", Now, Target.TextToDisplay
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