Makro für Excel erstellen

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Application.EnableEvents = True


Dim Benutzer As String
Dim Rechner As String
Dim Logfile As String
Dim Datum As String
Dim Uhrzeit As String

Logfile = c:\excel-zugriffe.txt
Benutzer = atCNames(1)
Rechner = atCNames(2)
Datum = Format(Now, dd.mm.yyyy)
Uhrzeit = Format(Now, HH:MM)
Dateiname = ActiveWorkbook.Name

Open Logfile For Append As #1
Print #1, Benutzer & vbTab & Datum & vbTab & Uhrzeit & vbTab & Rechner
Close #1

End Sub

Private Declare Function api_GetUserName Lib advapi32.dll Alias GetUserNameA (ByVal lpBuffer As String, nSize As Long) As Long

Private Declare Function api_GetComputerName Lib kernel32 Alias GetComputerNameA (ByVal lpBuffer As String, nSize As Long) As Long

Public Function atCNames(UOrC As Long) As String
On Error Resume Next
Dim NBuffer As String
Dim Buffsize As Long
Dim Wok As Long

Buffsize = 256
NBuffer = Space$(Buffsize)


If UOrC = 1 Then
Wok = api_GetUserName(NBuffer, Buffsize)
atCNames = Trim$(NBuffer)
Else
Wok = api_GetComputerName(NBuffer, Buffsize)
atCNames = Trim$(NBuffer)
End If
If Right(atCNames, 1) = Chr(0) Then
atCNames = Left(atCNames, Len(atCNames) - 1)
End If

End Function

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim Logfile As String
Dim Benutzer As String, Rechner As String
Dim Datum As String, Uhrzeit As String
Dim sWB As String, sWS As String, sAdr As String

Logfile = c:\excel-zugriffe.txt

Benutzer = atCNames(1)
Rechner = atCNames(2)

Datum = Format(Now, dd.mm.yyyy)
Uhrzeit = Format(Now, HH:MM)

sWB = Sh.Parent.Name->Name der Datei
sWS = Sh.Name-> Name des Arbeitsblattes
sAdr = Target.Address(True, True)-> Adresse

Open Logfile For Append As #1
Print #1, Benutzer & vbTab & _
     Datum & vbTab & Uhrzeit & vbTab & _
     Rechner & vbTab & _
     sWB & vbTab & sWS & vbTab & sAdr
Close #1

End Sub