|
Hallo
in ein Modul
Option Explicit
Sub Etiketten()
Dim TB As Worksheet, LR As Integer, i As Integer, j As Integer
Dim Sp As Integer, Ze As Integer, S1 As Integer, Z1 As Integer
Dim SpPos As Integer, SpZng As Integer, SpSt As Integer
Dim Zeile As Integer, Spalte As Integer, Neben As Integer
Dim sFormat As String, Txt As String
Set TB = Sheets("Etiketten Allgemein")
sFormat = "Pos: [Pos]" & vbLf & _
"Zng. Nr: [Zng]" & vbLf & _
"Stück: [Anz]"
S1 = 2 'erste Spalte
Spalte = S1
Z1 = 2 'erste Zeile
Zeile = Z1
Sp = 5 'Abstand der Spalten
Ze = 7 'Abstand der Zeilen
SpPos = 18
SpZng = 19
SpSt = 22
Neben = 3 'Anzahl Etiketten nebeneinander
LR = TB.Cells(TB.Rows.Count, SpZng).End(xlUp).Row 'letzte Zeile der Spalte
For i = 2 To LR 'alle Zeilen mit eingetragenen Zeichnungsnummern abarbeiten
For j = 1 To TB.Cells(i, SpSt) ' Schleife für Stück
Txt = sFormat
'Variable tauschen
Txt = Replace(Txt, "[Pos]", TB.Cells(i, SpPos))
Txt = Replace(Txt, "[Zng]", TB.Cells(i, SpZng))
Txt = Replace(Txt, "[Anz]", TB.Cells(i, SpSt))
TB.Cells(Zeile, Spalte) = Txt 'Etikett beschriften
Spalte = Spalte + Sp
If Spalte = Neben * Sp + S1 Then 'prüfen ob letzes Etikett in Zeile erreicht
Spalte = S1 'wieder vorne beginnen
Zeile = Zeile + Ze ' Nächste Reihe Etikett
End If
Next j
Next i
End Sub
LG UweD
|