Pokud nedo zamerne a se znalostmi odstranuje data, pak asi dobre zamete stopy. Pro nechtene lze dle nasledujiciho vysledovat, co se stalo.
Do sesitu vlozit list s nazvem "EventLog", sloupec A:A format vlastni "dd.mm.yy hh.mm.ss", B:F text.
Pocet ulozenych udalosti je nastaven ve Sub Workbook_Open a Sub EventLog.
Zobrazeni listu EventLog zavolanim Sub ZobrList, heslo je h, zadat v teto sub.
Predavane kody jsou ukazka.
V editoru VBA (a vlozit heslo pro pristup):
objekt Tento_sesit:
Kód: Vybrat vše
Option Explicit
Private Sub Workbook_Open()
Worksheets("eventlog").Visible = xlSheetVeryHidden
Set OldBlk = Worksheets("eventlog").Range("a1:f200") ' poslednich 200 zaznamu
Set NewBlk = OldBlk.Offset(1, 0)
Set NewRow = OldBlk.Resize(1, 1)
Set ws = ActiveWorkbook.BuiltinDocumentProperties
On Error Resume Next
LastAutor = ws(7).Value
' kod, sesit,,pocet listu v sesitu
EventLog "01", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_Activate()
EventLog "02", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_Deactivate()
EventLog "03", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
EventLog "04", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
EventLog "05", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
EventLog "06", "WB", vbNullString, ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Set Sht = ActiveSheet.UsedRange
' kod, sesit,list!oblast,pocet listu v sesitu
EventLog "11", "WB", ActiveSheet.Name & "!" & Sht.Address(0, 0), ActiveWorkbook.Sheets.Count
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Set Sht = ActiveSheet.UsedRange
EventLog "12", "WB", ActiveSheet.Name & "!" & Sht.Address(0, 0), ActiveWorkbook.Sheets.Count
End Sub
Objekt List1 a dalsi (upravit nazev listu):
Kód: Vybrat vše
Option Explicit
Dim OldValue As Variant
Private Sub CommandButton1_Click()
'zde vykonna procedura pro ovladaci prvek CommandButton1
'...
' kod, list!bunka, stara hodnota, nova hodnota
Range("a1").Activate
EventLog "21", "List1!CmB1", "co vykonano", vbNullString
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' kod, list!bunka, stara hodnota, nova hodnota
EventLog "21", "List1!" & Target.Address, OldValue, Target.Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
OldValue = Target.Value
End Sub
Objekt List EventLog:
Kód: Vybrat vše
Option Explicit
Private Sub Worksheet_Deactivate()
Worksheets("eventlog").Visible = xlSheetVeryHidden
End Sub
Modul1:
Kód: Vybrat vše
Option Explicit
Public LastAutor As String, Sht As Range
Public OldBlk As Range, NewBlk As Range, NewRow As Range
Public ws As Object, PNr As Byte
Sub EventLog(Kod As String, Adr As String, OldVal As Variant, NewVal As Variant)
Cont:
On Error GoTo Err
NewBlk.Value = OldBlk.Value
On Error GoTo 0
NewRow.Resize(1, 6).ClearContents
NewRow.Value = Now
NewRow.Offset(0, 1).Value = LastAutor
NewRow.Offset(0, 2).Value = Kod
NewRow.Offset(0, 3).Value = Adr
NewRow.Offset(0, 4).Value = OldVal
NewRow.Offset(0, 5).Value = NewVal
Exit Sub
Err:
Set OldBlk = Worksheets("eventlog").Range("a1:f200") ' poslednich 200 zaznamu
Set NewBlk = OldBlk.Offset(1, 0)
Set NewRow = OldBlk.Resize(1, 1)
Set ws = ActiveWorkbook.BuiltinDocumentProperties
On Error Resume Next
LastAutor = ws(7).Value
GoTo Cont
End Sub
Sub ZobrList() ' lze volat i klavesovou zkratkou
If Application.InputBox("Zadej heslo pro zobrazeni listu EventLog", , , , , , , 2) <> "h" Then Exit Sub
Worksheets("eventlog").Visible = True
Worksheets("eventlog").Activate
End Sub
'
'********************
Sub aa() 'testovaci
Dim Ofs As Integer, p As Object, Users, row
Ofs = 0
With Worksheets("list2").Range("a1")
For Each p In ActiveWorkbook.BuiltinDocumentProperties
.Offset(Ofs, 0).Value = p.Name
On Error Resume Next
.Offset(Ofs, 1).Value = p
Ofs = Ofs + 1
Next p
End With
' uzivatele
Users = ActiveWorkbook.UserStatus
With Worksheets("list2").Range("e1")
For row = 1 To UBound(Users, 1)
.Cells(row, 1) = Users(row, 1)
.Cells(row, 2) = Users(row, 2)
Select Case Users(row, 3)
Case 1
.Cells(row, 3).Value = "Exclusive"
Case 2
.Cells(row, 3).Value = "Shared"
End Select
Next
End With
End Sub
Měl bych dotaz na vás kolegové ohledně Excelu 2003. Denně vytváříme záznamy o stavu produkce při výrobě. Používáme sešity excelu a každý den nový prázdný vytvořený ze vzoru formou kopie,který se po ukončení práce ukládá do archívu kde má přístup hodně lidí po ethernetové síti,kteří následně tato data potřebují ke své práci. Stalo se mi i mím kolegům ,že po otevření sešitu ,který je zaheslován ( heslo pro zápis znají pouze 2 lidé a administrátor )a uložen v archívu neustále ve stejné složce je sešit BEZ ZAPSANÝCH DAT !!!!!. Všichni co mohou provádět zápisy se mi zapřisáhly ,že nikdo tuto práci nevymazal.Ze zkušenosti vím,že pokud dáte vlastnosti sešitu vidíte kdo naposledy provedl zápis a sešit uložil. Proto,je jasné jak se věci mají s aktuálním požadovaným sešitem. V sešitech jsou zápisy prováděny textem i formou čísel do tabulek a celý sešit obsahuje jednoduchá makra jako pro zápis datumu a nebo opakujícího se záznamu na tzv.tlačítka,která se po aktivaci provedou. Je možné,že by existovalo makro / které mi standartní uživatelé nepoznáme /,které by po uplynutí nějaké časové doby samo vymazalo všechen text zapsaný v tabulkách např.při opětovném otevření sešitů a nebo uložení atd..?????? 
