< návrat zpět
MS Excel
Téma: VBA - zapsaní jména před uložením 
Zaslal/a PavelSejnoha 18.7.2018 23:06
Zdravím.
Mám nějaký soubor na společném disku, do kterého zapisuje více uživatelů - cca 10 uživatelů.
Potřeboval bych kód, který před uložením zapíše jméno uživatele a datum a čas do listu 1.
V příloze jsem někde něco našel, ale nevyhovuje mi, že se dopisuje každé uložení vždy pod sebe.
Potřeboval bych kód, který u stejného uživatele pouze ve vedlejší buňce aktualizuje datum a čas uložení.
Pokud by byl nový/jiný uživatel a soubor by také uložil - dopíše ho to na konec - do volného řádku.
Dokáže mi s tím někdo pomoc.
Cílem by mělo být, abych neměl každé uložení v novém řádku, ale aby se to omezilo, např. u 10 uživatelů na 10 řádku.
Děkuji moc za každou pomoc
Pavel
Private Sub Workbook_BeforeSave(ByVal Saved As Boolean, _
Cancel As Boolean)
Dim PrazdnyRadek As Long
' prvni prazdny radek
PrazdnyRadek = Worksheets("list1").Cells.SpecialCells(xlCellTypeLastCell).Row + 1
' zapiseme kdo
Worksheets("list1").Cells(PrazdnyRadek, 1) = Application.UserName
' zapiseme kdy
Worksheets("list1").Cells(PrazdnyRadek, 2) = Now
ThisWorkbook.Save
End Sub
citovatStalker(21.7.2018 23:57)#040957 
Tohle by mělo splnit požadavek:
Private Sub Workbook_BeforeSave(ByVal Saved As Boolean, Cancel As Boolean)
Dim PrazdnyRadek As Long
Dim Jmeno As String
Dim rng As Range
Jmeno = Application.UserName
With Worksheets("list1")
Set rng = .Range("A:A").Find(What:=Jmeno, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not rng Is Nothing Then
' zapiseme kdy
.Cells(rng.Row, 2) = Now
Else
' prvni prazdny radek
PrazdnyRadek = .Cells(Rows.Count, 1).End(xlUp).Row + 1
' zapiseme kdo
.Cells(PrazdnyRadek, 1) = Jmeno
' zapiseme kdy
.Cells(PrazdnyRadek, 2) = Now
End If
End With
ThisWorkbook.Save
End SubcitovatDěkuji, moc mi to pomohlo!
PaS
citovat
RSS nejnovější články