Erweiterung der Info @ UweD

Guten Morgen liebe Excelianer!
Aus irgendeinem Grund kann ich auf meine Eigene gestellte Forumsfrage nicht mehr antworten, ich finde diesen auch nicht in der Forumsliste.
Leider weiß ich auch nicht, wie man einen Link zu meinem alten Beitrag vom 28.06.2014, welcher sich "Onfo ob gedruckt wurde" nannte.
Ich danke mal UweD, der probiert hat, mir zu helfen. Problem ist nur, es kommt jedes mal eine Fehlermeldung und ich habe keine Ahnung warum.
Habe den Code von Uwe eingefügt:
~ Private Sub Workbook_BeforePrint(Cancel As Boolean) Dim PZ As Range Dim UserN$, UserId$ UserN = Application.UserName UserId = Environ("Username") Set PZ = ActiveSheet.Range("A1") With PZ If TypeName(ActiveSheet) = "Worksheet" Then If Not .Comment Is Nothing Then If InStr(.Comment.Text, "gedruckt von: ") > 0 Then If MsgBox("Das aktuelle Tabelleblatt wurde bereits " _ & vbCrLf & .Comment.Text & " ," & vbCrLf _ & vbCrLf & "soll es noch einmal gedruckt werden?" _ , vbYesNo Or vbExclamation Or vbDefaultButton1, _ "Bereits gedruckt") _ = vbNo Then Cancel = True End If Else .AddComment .Comment.Text Text:="gedruckt von: " & vbCrLf & UserN & " / " & UserId End If End If End With End Sub ~
Habe mal eine kleine Testversion meiner Datie hochgeladen wo, wenn gedruckt wurde, in Zelle A51 die benötigte Info kommt.

Die Datei https://www.herber.de/bbs/user/91388.xlsm wurde aus Datenschutzgründen gelöscht

Wichtig für die Helfer ist nur, man muss mittels Button zuerst ein neues Formular anlegen, dieses nach Vorgabe ausfüllen (anklicken rechts des Formulares der retslichen Buttons) um überhaupt drucken zu können.
Mein Wunsch wäre, dass eben in Zelle A51 oder der MsgBox bei "Wurde bereits ausgedruckt" auch dabei steht, von welchem User also "Wurde bereits ausgedruckt von ..."
Entschuldigung nochmals dafür das ich hier doppelt Poste, aber ich habe keine Ahnung wie ich den alten Beitrag weiter führen kann.
Dann Danke vorab und schönes Wochenende allen,
lg Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforePrint(Cancel As Boolean) ' With ActiveSheet ' If .Cells(51, 1).Value = "Wurde bereits ausgedruckt" Then ' If MsgBox("Das aktuelle Tabelleblatt wurde bereits gedruckt, " _ ' & vbCrLf & "soll es noch einmal gedruckt werden?" _ ' , vbYesNo Or vbExclamation Or vbDefaultButton1, _ ' "Bereits gedruckt") _ ' = vbNo Then Cancel = True ' Else ' .Cells(51, 1).Value = "Wurde bereits ausgedruckt" ' End If ' End With Dim PZ As Range Dim UserN$, UserId$ UserN = Application.UserName UserId = Environ("Username") Set PZ = ActiveSheet.Range("A1") With PZ If TypeName(ActiveSheet) = "Worksheet" Then If Not .Comment Is Nothing Then If InStr(.Comment.Text, "gedruckt von: ") > 0 Then If MsgBox("Das aktuelle Tabelleblatt wurde bereits " _ & vbCrLf & .Comment.Text & " ," & vbCrLf _ & vbCrLf & "soll es noch einmal gedruckt werden?" _ , vbYesNo Or vbExclamation Or vbDefaultButton1, _ "Bereits gedruckt") _ = vbNo Then Cancel = True End If Else On Error Resume Next .Comment.Delete .AddComment .Comment.Text Text:="gedruckt von: " & vbCrLf & UserN & " / " & UserId End If End If End With End Sub

Sub Drucken() '... If bolDrucken = True Then ActiveSheet.Unprotect ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False, _ preview:=True 'Preview auf False setzen wenn alles funktioniert ActiveSheet.Protect Range("AW7").Select End If End Sub

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 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

Hallo an alle die geholfen haben, und die es vielleicht noch werden!
Habe nun alle Vorschläge, Tips usw. in die Tat umgesetzt und ich muss sagen,
es klappt Wunderbar.
Aufgefallen ist mir jedoch, dass in Zelle A51 oder der MsgBox immer nur derjenige Angezeigt bzw. eingetragen wird, der die Tabelle als erstes ausgedruckt hat.
Das heißt, wenn A als erstes die Tabelle ausgedruckt hat, B etwas ändert und erneut ausdruckt, bleibt trotzdem A als ausdrucker vermerkt.
Ist dies eventuell auch möglich so zu ändern das immer derjenige angezeigt wird, der als letzter ausdruckte?
Hab zwar gestern sehr viel Zeit damit verbracht um aus meinen alten Excelvorlagen eventuell einen passenden VBA Code zu finden und einzusetzen, was jedoch - so wie meist - kläglich scheiterte.
Deshalb wende ich mich, auch wenn es schon zum gefühlten 1.000 Mal ist, an Euch und sag schon mal danke allen im Voraus und hoffe ich bin nicht zu lästig mit meinen Wünschen.
lg Bernd

If InStr(.Value, "gedruckt von: ") > 0 Then MsgBox "IF-Zweig" 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 MsgBox "Else-Zweig!" 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

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

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread