|
'***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
|
