Új hozzászólás Aktív témák

• #54430 bpmcwap senior tag Mutt #54429

  Új Válasz 2025-05-28 08:53:07 #54430

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  bpmcwap

  senior tag

  válasz Mutt #54429 üzenetére

  magát az excelt mentettem le jelszóval és találtam egy ilyen kódot, amit meg naplózáshoz fogok használni... még nem próbáltam, de elvileg ez működik - ennyire nem értek hozzá

  Private Sub Workbook_Open()
Dim logSheet As Worksheet
Dim nextRow As Long
Dim userName As String
Dim timeStamp As String
Const LOG_SHEET_NAME As String = "Napló" ' A napló munkalap neve

On Error Resume Next
Set logSheet = ThisWorkbook.Sheets(LOG_SHEET_NAME)

' Ha nincs ilyen lap, létrehozza és nagyon elrejti
If logSheet Is Nothing Then
Application.ScreenUpdating = False
Set logSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
logSheet.Name = LOG_SHEET_NAME
logSheet.Cells(1, 1).Value = "Időbélyeg"
logSheet.Cells(1, 2).Value = "Felhasználó"
logSheet.Cells(1, 3).Value = "Esemény"
logSheet.Visible = xlSheetVeryHidden ' Nagyon rejtett!
Application.ScreenUpdating = True
End If
If logSheet Is Nothing Then Exit Sub ' Hiba esetén kilép
On Error GoTo 0 ' Visszaállítjuk a normál hibafigyelést a lapkezelés után

On Error Resume Next ' Újra bekapcsoljuk az általános hibaátugrást az íráshoz

userName = Environ("USERNAME") ' Windows felhasználónév
If userName = "" Then userName = "Ismeretlen"
timeStamp = Format(Now(), "yyyy-mm-dd hh:nn:ss")

' Következő üres sor keresése (rejtett lapon is működik)
nextRow = logSheet.Cells(logSheet.Rows.Count, "A").End(xlUp).Row + 1
If nextRow < 2 Then nextRow = 2

' Adatok írása
logSheet.Cells(nextRow, 1).Value = timeStamp
logSheet.Cells(nextRow, 2).Value = userName
logSheet.Cells(nextRow, 3).Value = "Megnyitva"

' Nem mentjük automatikusan a munkafüzetet itt!
On Error GoTo 0
End Sub

Új hozzászólás Aktív témák