Ich will auch was beitragen: Protokolle



Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: Ich will auch was beitragen: Protokolle
von: maxg
Geschrieben am: 17.05.2002 - 19:43:46

Hallo, VBA-User - MÄDELS und Jungs

Ich, der ich ganz neu in dieser User-Group bin, will auch mal etwas vorstellen, was Ihr vielleicht
gebrauchen könnt.

Ein Änderungsprotokoll.

Die Idee:
Da ich im Kreditwesen (Leiter EDV) arbeite, brauche ich jede Transaktion protokolliert, gleichgültig ob
ich auf Groß-, Midrange-Rechner oder PC (im Standalone oder Netzwerk) arbeite.

Da ich jetzt aber keine Lust habe, alles detailliert zu erklären (wie die Routinen funktionieren),
folgt anschließend die Routine.

Wer Fragen hat, kann sich über max@maxgalle.de an mich wenden.

Es gibt unter Euch aber sicherlich Leute, die mir vielleicht auch den einen oder anderen Hinweis geben
können, wie man das Ding besser realisieren kann.
Ich denke dabei z.B. (dafür habe ich noch keine Lösung gefunden) an die Installation in einem einzigen
Standard-Modul mit Gültigkeit über die gesamte Mappe mit all ihren Blättern.

Wichtig ist, daß das Protokoll nicht in der aktuellen Mappe sondern völlig extern als Textfile gespei-
chert wird.
Wichtig ist ferner die Extension des Protokollfiles: .jgf !
Ein "normaler" User kann das Ding nicht so einfach (mittels Editor) öffnen und ggf. manipulieren.

Einige Highlights:

- sie ist leicht zu installieren
- sie liefert Argumente gegen User-Aussagen wie "Ich habe überhaupt nichts gemacht !!"
- sie schaut nicht nur nach einer einzelen Zellveränderung sondern auch nach kopierten Zellen
- Im Falle von Formeln protokolliert sie die Formel
- protokolliert werden
- vollständiger Pfad und Workbookname
- Blattname
- Benutzer
- Zelladresse
- Zellname
- altem Wert
- neuem Wert
- Datum
- Zeit
- Einzelne Zelle, Bereichskopie oder Initialisierung:
Einzelne Zelle Falsch
Bereichskopie Wahr
Initialisierung Init
- sie erlaubt das Einlesen der Protokolldaten über einen Zeitraum ggf. begrenzt auf einen User


Die Routinen haben aber auch Nachteile:

- Wenn ich Zellen kopiere, kenne ich nicht mehr den vorherigen Wert der entsprechenden Zelle

Man muß halt in den Routinen rummachen, wenn kein BisDatum vorhanden ist.

Also, ich hoffe auf Response.

Und nur die Routine:
'----------------------------------------------------------------------
'
' Den folgenden Code-Teil in das jeweilige Objekt-Modul kopieren und
' aktivieren
'
'#######################################################################
'Option Explicit
'
'Public varValue As Variant
'Public strAddress As String
'Const Pfad = "C:\Temp\"
'
'Private Sub Worksheet_Change(ByVal Target As Range)
' Call wscAP_Change(Target, varValue, Pfad)
'End Sub
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Call wscAP_SelectionChange(varValue, strAddress)
'End Sub
'#######################################################################

Option Explicit
Const Pfad = "C:\Temp\"

Declare Function Get_User_Name Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long

'
Sub wscAP_Change(ByVal Target As Range, varValue, Pfad)

Dim c
Dim f, NewVal, OldVal, Satz, Benutzername, ZName As String
Dim dateiname As String
Dim FileNumber
Dim Bereich As Boolean

FileNumber = FreeFile
dateiname = Pfad & "XL_" & Format(Date, "yyyymmdd") & ".lgf"
Open dateiname For Append As #FileNumber
Benutzername = syGetUserName

Bereich = InStr(1, Target.Address, ":")

For Each c In Target

ZName = ""
On Error Resume Next
ZName = c.Name.Name

OldVal = CStr(varValue)
NewVal = CStr(c.Value)
If c.HasFormula Then NewVal = CStr(c.Formula)

If (OldVal <> NewVal) Or Bereich Then _
Call SchreibSatz(FileNumber, _
Benutzername, _
c.Address, _
ZName, _
OldVal, _
NewVal, _
Bereich)

If Bereich Then varValue = ""

Next

Close #FileNumber

End Sub

Sub wscAP_SelectionChange(varValue, strAddress)

varValue = ActiveCell.Value
If ActiveCell.HasFormula Then _
varValue = CStr(ActiveCell.Formula)
strAddress = ActiveCell.Address

End Sub

Private Sub InitBereich()

Dim iniRng, c, FileNumber
Dim OldVal, Benutzername, ZName, dateiname As String

Set iniRng = ActiveSheet.Range("A1:Z1000")

Benutzername = syGetUserName

dateiname = Pfad & "XL_" & Format(Date, "yyyymmdd") & ".lgf"
FileNumber = FreeFile
Open dateiname For Append As #FileNumber

For Each c In iniRng

ZName = ""
On Error Resume Next
ZName = c.Name.Name

OldVal = CStr(c.Value)
If c.HasFormula Then OldVal = CStr(c.Formula)

If (OldVal <> "") Then _
Call SchreibSatz(FileNumber, _
Benutzername, _
c.Address, _
ZName, _
OldVal, _
"", _
"Init")
Next

Close #FileNumber

End Sub
Private Sub SchreibSatz(fn, bn, ca, zn, ov, nv, kz)

Dim Satz As String

Satz = ActiveWorkbook.FullName & "," & ActiveSheet.Name & "," _
& bn & "," & ca & "," & zn & "," & ov & "," & nv & "," _
& Format(Date, "dd.mm.yyyy") & "," _
& Format(Time, "hh:nn:ss") & "," _
& kz

Write #fn, Satz

End Sub
Private Sub ProtokollLesen()

Dim Zeile, Datum
Dim ws As Worksheet
Dim dateiname, VonDatum, BisDatum, Benutzer As String

Set ws = Worksheets("Tabelle2")

VonDatum = "10.05.2002"
BisDatum = "18.05.2002"
Benutzer = ""

ws.Cells.ClearContents
Zeile = Zeile + 1

For Datum = CDate(VonDatum) To CDate(BisDatum)
Call LiesEinenTag(ws, Datum, Benutzer, Zeile)
Next

End Sub
Private Sub LiesEinenTag(ws, Datum, Benutzer, Zeile)

Dim Satz, x, z, FileNumber
Dim arr() As String
Dim dateiname As String
Dim dt
Dim BenutzerAngabe As Boolean

FileNumber = FreeFile
dt = Format(Datum, "yyyymmdd")

dateiname = Pfad & "XL_" & dt & ".lgf"
On Error GoTo ende2
Open dateiname For Input As #FileNumber
BenutzerAngabe = (Benutzer <> "")

While Not EOF(FileNumber)

Input #FileNumber, Satz
arr = SplitString(Satz, ",")

If BenutzerAngabe And (arr(3) <> Benutzer) Then GoTo ende

For x = 1 To UBound(arr)

Set z = ws.Cells(Zeile, x)
z.Value = "'" & arr(x)

Next
Zeile = Zeile + 1
ende:
Wend

Close #FileNumber
ende2:
End Sub
Private Function SplitString(ByVal txt As String, strSeparator As String)
Dim arr() As String
Dim intCounter As Integer
Do
intCounter = intCounter + 1
ReDim Preserve arr(1 To intCounter)
If InStr(txt, strSeparator) Then
arr(intCounter) = Left(txt, InStr(txt, strSeparator) - 1)
txt = Right(txt, Len(txt) - InStr(txt, strSeparator))
Else
arr(intCounter) = txt
Exit Do
End If
Loop
SplitString = arr
End Function
Private Function syGetUserName() As String
Dim lpBuff As String * 25

Get_User_Name lpBuff, 25
syGetUserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function


nach oben   nach unten

hast post,
von: Steffen
Geschrieben am: 19.05.2002 - 21:02:19

habe interesse,

habe Dir ne mail geschrieben

Tschau

Steffen


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "neue Dateien in einem Excel Makro verarbeiten?"