Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1736to1740
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mehrfach kopieren bereich untereinander, Print

mehrfach kopieren bereich untereinander, Print
25.01.2020 14:54:41
Hans
Hallo zusammen
Etiketten drucken mit ein Etikettendrucker.
Momentan kan ich an hand von NUR ein Artikelnummer ein Etikett kopieren und drucken, grün markiert kein Problem.
Layout ist im Tabblatt "Layout_etikett" definiert, dies wird in X mal kopiert nach Anzal Print
Beispieldatei
https://www.herber.de/bbs/user/134698.xlsm
Möchte Gerne eine Erweiterung Etikettendruck
Möchte aber mehrere Artikelnummern eingeben und nach eingabe Anzahl Spalte C, alle Artikelnummer mit Anzahl, Layout kopieren und Drucken.
Als extra wenn’s geht:
Spalte “D“ Eingabe X Kopieren freigeben, und Spalte “E“ Rückmeldung ob kopiert ist in Tabellenblatt “Etikett_Print“
freundlichen Grüße
Hans

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: mehrfach kopieren bereich untereinander, Print
25.01.2020 19:54:47
Hans
Hallo
scheinbar etwas flasch gemacht, habe fragen auf offen gestelt
viele grüße
Hans
AW: mehrfach kopieren bereich untereinander, Print
26.01.2020 21:45:43
Piet
Hallo Hans
anbei deine Beispieldatei zurück, mit einem deutlich verbesserten Code. Wie gefallt dir jetzt deine Tabelle "Etikett-ğrint"? Er ist noch nicht ganz Optimal, die letzten 4+1 Etikett wurden nicht erfasst. Vielleicht kannst du meine Idee noch weiter verbessern, wenn du meinen Code verstanden hast.
Max. gehen 11 Etiketts auf ein Blatt, wenn du mehr drucken willst müsste man knobbeln wie man sie untereinander oder nebeneinander druckt. Als Mensch kann man leicht erkennen wie man das Optimieren kann,aber wie sagt man das dem PC? Da ist noch einige Tüfftelarbeit das zu Optimieren. Dfür habe ich wahrscheinlich keine Zeit mehr, fahre in 2 Tagen in Urlaub.
Ich bingespannt wie dir mein Code gefaellt ....
https://www.herber.de/bbs/user/134721.xlsm
mfg Piet
Anzeige
AW: mehrfach kopieren bereich untereinander, Print
27.01.2020 07:07:52
Hans
Guten Morgen Piet,
das sieht nicht schlecht aus, aber es riecht wenn alle Etiketten untereinander kommen.
Alle Etiketten werden auf eine Endlos rolle mit eine Etikettendrucker gedruckt, da hatte ich nicht dran gedacht das zu erwähnen.
Möchstest du noch Zeit haben dan gerne alle untereinander, ich wünsche dir jedenfalls eine schöne erholsame Urlaub :-)
Code sieht sehr schön aus kann ich viel aus lernen, Super.
Beste grüße
Hans
AW: mehrfach kopieren bereich untereinander, Print
27.01.2020 13:39:02
Piet
Hallo Hans
ich habe es mal umgeschrieben für untereinander drucken. Hoffe das es einwandfrei laeuft. Muste eine Fehlermeldung mit dem letzten Befehl abfangen, vor Next AC! - Dort kannst du auch EZei = EZei + xx die Anzahl der Leerzeilen zwischen den Etiketts selbst einstellen, oder auf Null stellen. Ich hoffe das es gut klappt, konnte nicht viel testen. Toi, toi, toi ...
mfg Piet
'umgeschrieben für Endlos Etikettdrucker
Sub Kopieren_Print_untereinander()
Dim AC As Range, EZei As Long
Dim EGB As Worksheet, lz1 As Long
Dim Anzahl As Integer, j As Integer
Dim rngVor As Range, rngR As Range
Dim lngZ As Long, lngS As Long, ii As Long
Set EGB = Sheets("Eingabe")
lz1 = EGB.Cells(100, 2).End(xlUp).Row
Sheets("Etikett_print").UsedRange.EntireRow.Delete
Application.ScreenUpdating = False
'Eingabe in Hifsspalten kopieren + sortieren
EGB.Range("B4:D" & lz1).Copy
EGB.Range("P4").PasteSpecial xlPasteValues
EGB.Range("G4:H" & lz1).Copy
EGB.Range("S4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Alle Eingaben Ohne "X" löschen
For Each AC In EGB.Range("O4:O" & lz1)
If UCase(AC.Offset(0, 3))  "X" Then _
AC.Resize(1, 7).ClearContents
Next AC
'Eingabe in Hifsspalten sortieren
EGB.Range("P4:T" & lz1).Sort Key1:=EGB.Range("Q4"), Order1:=xlDescending, _
Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
On Error GoTo Fehler
'Schkeife zum ausfüllen von "Etikett_print"
For Each AC In EGB.Range("P4:P" & lz1)
Anzahl = AC.Cells(1, 2).Value
With Sheets("Layout_etikett")
'VBA Etikett ausfüllen
.Range("A10").Value = AC.Cells(1, 1)
.Range("A12").Value = AC.Cells(1, 4)
.Range("B13").Value = AC.Cells(1, 5)
'VBA Etikett Bereich festlegen
Set rngVor = .Range("A10:B14")
lngS = rngVor.Columns.Count
lngZ = rngVor.Rows.Count * Anzahl
End With
'VBA Etikett ğber Spalten Offset ausfüllen
With Sheets("Etikett_print").Range("A1").Offset(EZei, 0).Resize(lngZ, lngS)
rngVor.Copy                            ' kopieren
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
.Cells.Interior.ColorIndex = xlNone
Application.CutCopyMode = False
For lngZ = 1 To rngVor.Rows.Count      ' Zeilenhöhen
Set rngR = .Rows(lngZ)
For ii = 0 To Anzahl - 1
.Cells((ii * 5) + 5, 1).Value = ii + 1                                      'Zä _
hler
Set rngR = Union(rngR, .Rows(lngZ + ii * rngVor.Rows.Count))
Next ii
rngR.RowHeight = rngVor.Rows(lngZ).RowHeight
Next lngZ
End With
EZei = Sheets("Etikett_print").Cells(Rows.Count, 1).End(xlUp).Row
EZei = EZei + 1   'Anzahl Leerzeilen zwischen Etiketts
'** Unbedingter Aussprung, sonst laeuft Makro in Fehlermeldung!!
If AC.Cells(2, 1).Value = "" Then Exit For
Next AC
'**  Daten zum Testen nicht löschen!'!
'    Worksheets("eingabe").Range("B4:H12").Value = ""
Worksheets("Etikett_print").PrintOut Copies:=1, Collate:=True
Application.ScreenUpdating = True
Exit Sub
Fehler:  MsgBox "unerwarteter Fehler:  " & vbLf & Error()
End Sub

Anzeige
AW: Danke Piet, Owt
28.01.2020 16:10:08
Hans
Danke Piet
Eine Schöne Urlaub
Grüße
Hans
AW: Danke Piet, Owt
28.01.2020 16:10:51
Hans
Danke Piet
Eine Schöne Urlaub
Grüße
Hans

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige