Evidencia otvoreni xls suboru Vyřešeno

[samot]

Ahoj vospolok.
Vedel by mi, prosím, niekto poradiť, či sa to vôbec dá a ako áno, ako vytvoriť štatistiku otvorení xls suboru v rámci daného suboru. Malo by to zapisovať identifikator vstupujuceho - jeho osobne číslo, pod ktorým je prihlásený na PC a podla možnosti aj čas/dátum vstupu. Verzia EXCELU je 2003
ďakujem

[Reklama]

[Azuzula]

Ahoj, chceš tu evidenci uživatele přímo do nějakého listu toho souboru xls a nebo zvlášť do txt?

[cmuch]

Tady je ukázka pro list1 kam se bude ukládat kdo a kdy otevřel.

Kód: Vybrat vše

Private Sub Workbook_Open()
Dim poslradek As Long

 poslradek = Cells(Rows.Count, "A").End(xlUp).Row + 1

 Sheets("List1").Range("A" & poslradek).Value = Application.UserName & " " & Now  ' uzivatel z Excelu
 Sheets("List1").Range("B" & poslradek).Value = Environ("UserName") & " " & Now ' uzivatel z OS Win

End Sub


[samot]

to Azuzula: Ahoj. Priamo do listu v danom subore to bude akurát
to cmuch: kam daný kod priradiť? Dať to ako makro, či...? V tom som kus lama Mohol by som poprosiť integrované priamo do nejakého xls
ináč office je anglický. Nemôže to robiť problém?

[cmuch]

Kod vložit přes Alt+F11 do ThisWorkBook.

[samot]

dačo musím robiť zle, bo nefunguje to. Tvoj príklad ano. Ale ak kod implementujem do suboru sa datami (grafy, pivot,...), tak ma to ignoruje.

Ale teraz vidím, že vlastne lepšie by bolo zapisovať to externe, do txt. Bo väčšina to bude otvárať ako read-only

[Azuzula]

V tom případě tady mám jednoduchou variantu zápisu do txt. Ale někde se psalo, že to je prý stará metoda ale ta nová "lepší" vyžaduje zapnutou knihovnu pro VBA a haldu kódu navíc.

Kód: Vybrat vše

Private Sub Workbook_Open()
Dim staryText As String, soubor As String
Dim ff As Long

ff = FreeFile
soubor = "C:\soubor.txt" 'stačí změnit cestu k souboru

On Error GoTo zapis
Open soubor For Input As #ff
staryText = Input(LOF(ff), #ff)
Close #ff

zapis:
Open soubor For Output As #ff
Print #ff, staryText & Now() & " - " & Application.UserName
Close #ff
End Sub


Opět nakopírovat do ThisWorkbook

[cmuch]

Tak do toho svého souboru vlož toto přes Alt+F11 do ThisWorkBook

Kód: Vybrat vše

Option Explicit

Private Sub Workbook_Open()
Dim poslradek As Long
Dim soubor, listevidence As Variant
Dim cesta As String

'nadefinovani promennych
soubor = "nazev.xls"
cesta = "c:\Users\Cmuch\Documents\" ' cesta slozky kde je soubor
listevidence = "List1"

On Error GoTo konec 'vpripade ze soubor neexistuje tak preskoc
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Workbooks.Open Filename:=cesta & soubor

poslradek = Workbooks(soubor).ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

 Workbooks(soubor).Sheets(listevidence).Range("A" & poslradek).Value = Application.UserName & " " & Now  ' uzivatel z Excelu
 Workbooks(soubor).Sheets(listevidence).Range("B" & poslradek).Value = Environ("UserName") & " " & Now ' uzivatel z OS Win


Workbooks(soubor).Close savechanges:=True

konec:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Potom si vytvoř sešit "název.xls" s listem "List1" nebo jak chceš, ale změň v makru hned na začátku + změň cestu k souboru

[samot]

díky moc. velmi ste mi pomohli. keď vyrastiem, oplatím vám to :-)