Schritt für Schritt wie man die Makro in Trennstreifen-Drucken-Projektmapper hinzufügt.
Quellcode
Sie können den Quellcode direkt unten kopieren oder als mit Excel-Datei ohne Makro zusammen runterladen.
Option Explicit
'*** Die nachfolgende Programm-Methode (Sub) fügt den Text aus den
Public Sub printTrennStreifen()
On Error GoTo Fehlermeldung '*** im Fehlerfall eine Fehlermeldung ausgeben
'*** Definitionen der erforderlichen Variablen
Dim oWsht As Worksheet '*** dient zum Festlegen des Arbeitsblattes mit den Daten
Dim iRow As Integer '*** wird als Zeilenzähler genutzt
Dim iCntRequest As Integer '*** Zähler zum Nachfragen, ob weiter gemacht werden soll
Dim iRequestMax As Integer '*** nach soviel Ausdrucken, soll nachgefragt werden.
Dim strText As String '*** hierin wird der zu druckende Text zusammengestellt
Dim msgAntwort As VbMsgBoxResult
Dim msgAntwort_2 As VbMsgBoxResult
'*** Zuerst den Benutzer fragen, ob die Ausgabe an den Drucker gesendet
'*** oder nur die Ergebnisse ausgedruckt werden sollen bzw. ob er abbrechen will
msgAntwort = MsgBox("Klicken Sie" & vbCrLf & "[Abbrechen] = Programmlauf beenden" _
& vbCrLf & "[Nein] = nicht drucken, aber Simulation starten" _
& vbCrLf & "[Ja] = Trennstreifen drucken", vbYesNoCancel + vbDefaultButton2 + vbInformation, _
"Wie wollen Sie verfahren?")
If msgAntwort = vbCancel Then
'*** falls der Benutzer abbrechen will, dann Programm abbrechen
Exit Sub '*** einfach diese Sub verlassen (=beenden)
End If
'*** die auszugebenden Daten stehen ab Zeile 2
iRow = 2
'*** Zuweisung der Variablen dem Arbeitsblatt "Daten"
Set oWsht = Sheets("Daten")
'*** die Anzahl der Ausdrucke bis zur Nachfrage einlesen
On Error Resume Next '*** falls ein Fehler auftritt, wird in der nachfolgenden Zeile weitergemacht
iRequestMax = 100 '*** falls nichts hinterlegt oder keine Zahl, dann ist das der Defaultwert
iRequestMax = CInt(oWsht.Cells(9, 5).Value)
iCntRequest = 0 '*** Start des Zählers mit 0
On Error GoTo Fehlermeldung '*** vorherige Fehlerbehandlung beenden und im Fehlerfall eine Fehlermeldung ausgeben
'*** das erste Arbeitsblatt "Trennstreifen" soll ausgewählt und am Bildschirm angezeigt werden
Sheets(1).Select
'*** Nachfolgend die Schleife solange ausführen, wie Text (Inhalt) in der Spalte B vorhanden ist
Do While oWsht.Cells(iRow, 2).Value <> ""
'*** Text für die erste Zeile einlesen
strText = oWsht.Cells(iRow, 3).Value
If strText <> "" Then
'*** dann auch den Text der ersten Zeile drucken
If oWsht.Cells(2, 4).Value <> "" Then
'*** wenn in der Zelle D2 ein Text enthalten ist, wird dieser als Starttext verwendet
strText = oWsht.Cells(2, 4).Value & " " & strText
End If
If oWsht.Cells(2, 5).Value <> "" Then
'*** wenn in der Zelle E2 ein Text enthalten ist, wird dieser als Schlusstext verwendet
strText = strText & " " & oWsht.Cells(2, 5).Value
End If
'*** diesen ggf. zusammgesetzten Text nun in das Arbeitsblatt "Trennstreifen" als erste Zeile einfügen
Cells(44, 1).Value = strText
End If
'*** dann den Text aus der Spalte B holen und ggf. mit den Start- und Endtexten verketten
strText = oWsht.Cells(iRow, 2).Value
If oWsht.Cells(3, 4).Value <> "" Then
'*** wenn in der Zelle D3 ein Text enthalten ist, wird dieser als Starttext verwendet
strText = oWsht.Cells(3, 4).Value & " " & strText
End If
If oWsht.Cells(3, 5).Value <> "" Then
'*** wenn in der Zelle E3 ein Text enthalten ist, wird dieser als Schlusstext verwendet
strText = strText & " " & oWsht.Cells(3, 5).Value
End If
'*** Text für das Arbeitsblatt "Trennstreifen" in die zweite Zeile einfügen
Cells(45, 1).Value = strText
If msgAntwort = vbYes Then
'*** wenn der Benutzer die Ausgabe an den Drucker senden will, aktives Arbeitsblatt "Trennblatt" ausdrucken
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
iCntRequest = iCntRequest + 1 '*** Zähler der erfolgten Ausdrucke erhöhen
If iCntRequest Mod iRequestMax = 0 Then
'*** wenn ein Vielfaches der Anzahl zum Nachfragen erreicht ist, kommt eine Meldungsbox zum Nachfragen
msgAntwort_2 = MsgBox("[OK] = nächsten Block asudrucken" _
& vbCrLf & "[Abbrechen] = Programmlauf beenden", _
vbOKCancel + vbDefaultButton1 + vbInformation, _
"Nachfrage: Ausdrucken fortführen?")
If msgAntwort_2 = vbCancel Then
'*** wenn der Benutzer beenden will, dann jetzt beenden
Exit Sub '*** einfach diese Sub verlassen (=beenden)
End If
End If
Else
'*** falls der Benutzer nur simulieren will, dann nachfragen, ob das nächste angezeigt oder bendet werden soll
msgAntwort_2 = MsgBox("[OK] = nächste Ausgabe" _
& vbCrLf & "[Abbrechen] = Programmlauf beenden", _
vbOKCancel + vbDefaultButton1 + vbInformation, _
"Ausgabe fortführen?")
If msgAntwort_2 = vbCancel Then
'*** wenn der Benutzer beenden will, dann jetzt beenden
Exit Sub '*** einfach diese Sub verlassen (=beenden)
End If
End If
'*** Zeilenzähler auf die nächste Zeilen erhöhen
iRow = iRow + 1
Loop
Exit Sub '*** beenden des Programmlaufs (die nachfolgende Fehlermeldung ist nur im Fehlerfall zu durchlaufen)
Fehlermeldung:
MsgBox "Es ist ein Fehler aufgetreten: " & Err.Description, vbCritical + vbOKOnly, "Programmlauf wird beendet!"
End Sub
Letzte Aktualisierung am 2021-05-05 von EPI