AW: Etiketten drucken, mit untersch. Nummern
30.01.2013 00:44:24
fcs
Hallo Helmut,
probier dein Glück mal mit dem folgenden Makro.
Gruß
Franz
Sub EttikettenDrucken()
Dim Zeile As Long
Dim wksEtikett As Worksheet
Dim wksVorgabe As Worksheet
'Für die Ettketten und die Vorgaben darf auch das gleiche Tabellenblatt angegeben werden
Set wksEtikett = Worksheets("Etikett")
Set wksVorgabe = Worksheets("Vorgaben")
With wksVorgabe
If IsNumeric(.Range("M17")) And .Range("M17") > 0 Then
If MsgBox("Jetzt " & .Range("M17").Text & " Kopien je Etikett drucken", _
vbQuestion + vbOKCancel, _
"Etiketten drucken") = vbCancel Then Exit Sub
If .Range("E85") "" Then
For Zeile = 85 To .Cells(.Rows.Count, 5).End(xlUp).Row
If Not IsNumeric(.Cells(Zeile, 5)) Then Exit For
wksEtikett.Range("C12").Value = wksVorgabe.Cells(Zeile, 5).Text
wksEtikett.PrintOut Copies:=wksVorgabe.Range("M15").Value
Next
MsgBox "Alle Druckaufträge abgesendet."
Else
MsgBox "kein Eintrag in Zelle ""E85""", _
vbInformation + vbOKOnly, "Etiketten drucken"
End If
Else
MsgBox "Für die Anzahl der Kopien ist kein nummerischer Wert >0 eingegeben", _
vbInformation + vbOKOnly, "Etiketten drucken"
End If
End With
End Sub