Gedruckt von, Erweiterung?

Wunderschönen guten Morgen!
Ich habe da mal zwei Fragen, ob nachstehender Code veränderbar ist.
Hier mein jetziger Code, welchen ich auch hier erhalten habe:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim PZ As Range
Dim UserN$, UserId$, UserPc$
On Error GoTo Fehler
UserN = Application.UserName
UserId = Environ("Username")
UserPc = Environ("Computername")
Set PZ = ActiveSheet.Range("A51") 'Zielzelle
With PZ
If TypeName(ActiveSheet) = "Worksheet" Then
If InStr(.Value, "gedruckt von: ") > 0 Then
If MsgBox("Das aktuelle Tabelleblatt wurde bereits " & vbCrLf & .Value _
& " ," & vbCrLf & vbCrLf & "soll es noch einmal gedruckt werden?", vbYesNo Or vbExclamation Or  _
vbDefaultButton1, "Bereits gedruckt") = vbNo Then
Cancel = True
Else
.Value = "gedruckt von: " & UserN & " / " & UserId & " am PC " & UserPc
End If
Else
Application.EnableEvents = False 'unterbindet das ChangeEvent
'ActiveSheet.Unprotect Password:="abc" 'wenn Passwort verwendet wurde
.Value = "gedruckt von: " & UserN & " / " & UserId & " am PC " & UserPc
'ActiveSheet.Protect Password:="abc"
Application.EnableEvents = True ' Events wieder einschalten
End If
End If
End With
Err.Clear
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Meine Fragen wären, wenn das Blatt gedruckt wurde, wird dies ja am Blatt, in Zelle A51 vermerkt (wer das Blatt von wo aus gedruckt hat).
Wenn es erneut gedruckt wird, wird die Zelle A51 überschrieben.
Ist es möglich, nach jedem erneuten Drucken, dies fortlaufend einzutragen?
Also nach dem ersten Druck in Zelle A51, nach dem zweiten Druck in Zelle A52 usw.
Meine zweite Frage, ist es möglich zuzüglich zu den Informationen wer gedruckt hat, auch das Datum und die Uhrzeit mit einzutragen?
Da meine VBA Kenntnisse nur begrenzt sind, würde ich um dementsprechende Änderung meines o.a. Codes bitten, falls dies machbar ist.
Ich Danke schon mal im Voraus und wünsche jeden einen schönen Wochenstart,
mfg Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim PZ As Range Dim UserN$, UserId$, UserPc$ Dim bolPrint As Boolean On Error GoTo Fehler UserN = Application.UserName UserId = Environ("Username") UserPc = Environ("Computername") Set PZ = ActiveSheet.Range("A51") 'Zielzelle If TypeName(ActiveSheet) = "Worksheet" Then bolPrint = True If InStr(PZ.Value, "gedruckt von: ") > 0 Then Do Until PZ.Offset(1, 0) = "" Set PZ = PZ.Offset(1, 0) Loop If MsgBox("Das aktuelle Tabelleblatt wurde bereits " & vbCrLf & PZ.Value _ & " ," & vbCrLf & vbCrLf & "soll es noch einmal gedruckt werden?", _ vbYesNo + vbExclamation + vbDefaultButton1, _ "Bereits gedruckt") = vbNo Then bolPrint = False Else Set PZ = PZ.Offset(1, 0) End If End If If bolPrint = True Then Application.EnableEvents = False 'unterbindet das ChangeEvent 'ActiveSheet.Unprotect Password:="abc" 'wenn Passwort verwendet wurde PZ.Value = "gedruckt von: " & UserN & " / " & UserId & " am PC " _ & UserPc & Format(Now, " YYYY-MM-DD hh:mm:ss") 'ActiveSheet.Protect Password:="abc" Application.EnableEvents = True ' Events wieder einschalten Else Cancel = True End If End If Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim PZ As Range, PZ2 As Range Dim UserN$, UserId$, UserPc$ Dim bolPrint As Boolean On Error GoTo Fehler UserN = Application.UserName UserId = Environ("Username") UserPc = Environ("Computername") Set PZ = ActiveSheet.Range("A51") 'Zielzelle Set PZ2 = ActiveSheet.Range("B51") 'Prüfzelle If TypeName(ActiveSheet) = "Worksheet" Then bolPrint = True If InStr(PZ.Value, "gedruckt von: ") > 0 Then Do Until PZ.Offset(1, 0) = "" Set PZ = PZ.Offset(1, 0) Loop If PZ2.Value = PZ2.Offset(1, 0).Value Then If MsgBox("Das aktuelle Tabelleblatt wurde bereits " & vbCrLf & PZ.Value _ & " ," & vbCrLf & vbCrLf & "soll es noch einmal gedruckt werden?", _ vbYesNo + vbExclamation + vbDefaultButton1, _ "Bereits gedruckt") = vbNo Then bolPrint = False Else Set PZ = PZ.Offset(1, 0) End If Else Set PZ = PZ.Offset(1, 0) End If End If If bolPrint = True Then Application.EnableEvents = False 'unterbindet das ChangeEvent 'ActiveSheet.Unprotect Password:="abc" 'wenn Passwort verwendet wurde PZ.Value = "gedruckt von: " & UserN & " / " & UserId & " am PC " _ & UserPc & Format(Now, " YYYY-MM-DD hh:mm:ss") PZ2.Offset(1, 0).Value = PZ2.Value 'ActiveSheet.Protect Password:="abc" Application.EnableEvents = True ' Events wieder einschalten Else Cancel = True End If End If Err.Clear Fehler: If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread