Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1832to1836
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

Nach Seitenumbruch weiter

Nach Seitenumbruch weiter
16.06.2021 21:23:24
Eberhard
Guten Abend
Hab mir gedacht, dass ich plötzlich nicht weiter komme.
Unterstehender Code funktioniert soweit recht gut. Durch eine Listbox (MultiSelect) können mehrere Lagerorte ausgewählt werden. Diese werden dann durchsucht und alle Namen welche sich in diesem Lagerort befinden aufgelistet. Dabei wird eine Überschrift mit dem Lagerort , Name, Vorname usw. erstellt. Gleichzeitig überprüft es ob der ausgewählte Lagerort auf der Seite noch platz hat. Wenn nicht, macht es einen Seitenumbruch.
Nun komme ich nicht weiter. Danach sollte es den Rest der Suche auf die nächste Seite schreiben. Hoffe Ihr versteht in etwa was ich meine?
Ihr mal mein Code:

Private Sub CommandButton4_Click()
Dim i As Long
Dim Suchen As String
Dim ws As Worksheet
Set ws = Worksheets("Lagerliste_drucken")
With ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then Exit For
Next
If i = .ListCount Then
MsgBox "Bitte Auswahl treffen"
Exit Sub
End If
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
Suchen = strAusgabe & .List(i)
Set rng = Worksheets("WSCAR_Daten").Range("F:F").Find(Suchen, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If rng Is Nothing Then
MsgBox "Lagerort " & Suchen & " nicht gefunden!", vbInformation
Else
If WorksheetFunction.CountIf(Worksheets("WSCAR_Daten").Range("F:F"), Suchen)  sfirstaddress
Else
ws.HPageBreaks.Add before:=Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1)
End If
End If
End If
Next
End With
End Sub
Gruss Daniel

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nach Seitenumbruch weiter
17.06.2021 23:03:07
Yal
Hallo Daniel,
wenn Du einigen geschlossen Handlung in separaten Sub/Function ablegst, wird dein Code leichter zu lesen:

Private Sub CommandButton4_Click()
If Selektierte_auszählen(Listbox1) = 0 Then
MsgBox "Bitte Auswahl treffen"
Exit Sub
End If
End Sub
Private Function Selektierte_auszählen(ListBox) As Long
Dim i
With ListBox
For i = 0 To .ListCount - 1
If .Selected(i) Then Selektierte_auszählen = Selektierte_auszählen + 1
Next
End With
End Function
Beide folgende If-Test sind equivalent:

If .Selected(i) = True Then
If .Selected(i) Then
Suchen, ob eine Wert vorhanden ist, oder Zähler wie oft es vorkommt, ist -fast- das Gleich. Daher machst Du die Prüfung doppelt.
Allgemein ist das Suchen mit "Find" nur hilfreich, wenn eine grosse Menge an Zelle durchgesucht werden sollten. Da sich hier alles in Spalte F abspielt, geht vielleicht gezielter, wenn man jede Zeile nacheinander läuft.
Das Gesamt ist umständlich. Man könnte einfach diese 2-zeilige Kopfbereich beim Druck wiederholen. Unter "Seitenlayout", "Drucktitel" kannst Du unter Wiederholungszeilen oben definieren , welche Zeile auf alle Seiten vorkommen sollen. Mit Makro Rekorder sieht es so aus:

ActiveSheet.PageSetup.PrintTitleRows = "$1:$2"
Das gesamte sieht dann so aus:

Private Sub CommandButton4_Click()
Dim i As Long
Dim Suchen As String
Dim Z As Range
Dim Treffer
Dim ws As Worksheet
Set ws = Worksheets("Lagerliste_drucken")
If Selektierte_auszählen(Listbox1) = 0 Then
MsgBox "Bitte Auswahl treffen"
Exit Sub
End If
ws.Range("A2:F2") = Array("Vorname", "Name", "Marke", "Typ", "Kontrollschild")
ws.Range("A1").MergeArea.BorderAround xlContinuous, xlMedium, xlColorIndexAutomatic
ws.Range("A1", "A2:F2").Borders.LineStyle = xlContinuous
ws.Range("A1", "A2:F2").Font.Bold = True
ws.PageSetup.PrintTitleRows = "$1:$2"
For i = 0 To .ListCount - 1
If .Selected(i) Then
Suchen = strAusgabe & .List(i)
For Each Z In Worksheets("WSCAR_Daten").Range("F:F")
If Z = Suchen Then
Treffer = True
Z.Offset(0, -5).Resize(1, 5).Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next
End If
Next
If Not Treffer Then
MsgBox "Lagerort " & Suchen & " nicht gefunden!", vbInformation
ws.Range("A1:F5").ClearContents
End If
End Sub
Private Function Selektierte_auszählen(ListBox) As Long
Dim i
With ListBox
For i = 0 To .ListCount - 1
If .Selected(i) Then Selektierte_auszählen = Selektierte_auszählen + 1
Next
End With
End Function
VG
Yal
Anzeige
AW: Nach Seitenumbruch weiter
18.06.2021 06:51:46
Eberhard
Guten Morgen Yal
Vielen Dank für Deinen Vorschlag. Sieht ganz ordentlich aus und auch nicht so lang. Macht jedoch nicht ganz, was ich eigentlich möchte.
Habe mal eine Datei gebastelt, damit Du Dir in etwa ein Bild machen kannst, wie es aussehen sollte.
Vielleicht hilft das weiter!
https://www.herber.de/bbs/user/146658.xlsm
Vielen Dank für die Unterstützung.
Gruss Daniel und einen schönen Freitag.
AW: Nach Seitenumbruch weiter
18.06.2021 10:35:23
Yal
Hallo Daniel,
bei den Wiederholungszeilen "sieht" das Ergebnis in Excel nicht wie es ausgeruckt wird. Es wird aber die erste Zeile (oder 2..n) auf jede Seite oben gedruckt, und zwar in der Form wie sie im ersten Zeile vorliegt. Ich dachte, dass wäre das Ziel.
Wenn es schon "in Excel richtig aussehen soll", 2 Alternative:
1. Kopfbereich nachträglich einfügen:
der Kopfbereich übertragen,
dann alle Treffer übertragen,
dann jede 49te Zeilen den Pagebreak und Kopfbereich als neue Zeilen hinzufügen.
2. in Schliefe über Pakete von 49 Zielen

Do While EsGibtEinenTreffer
Kopfzeilen_einfügen
For i = 1 To 49
If EsGibtEinenTreffer Then
Zeile_übertragen
NächsteTeffer_suchen
Else
Exit Do
End If
Next
Loop
(Pseudo-Code. Wobei, wenn die gerufenen Sub/Function so heissen würden, wäre es ein gültigen Code)
VG
Yal
Anzeige
AW: Nach Seitenumbruch weiter
18.06.2021 16:50:38
Eberhard
Hallo Yal
Danke für Deine super Hilfe. Werde mich am Wochenende mal damit befassen. Hoffe, dass ich wenn ich nicht weiter komme, wieder fragen darf?
Gruss und ein schönes Wochenende.
Gruss Daniel
Nein, darfst Du nicht ;-))
19.06.2021 21:22:52
Yal
Seitenumbruch einfügen
21.06.2021 00:39:24
Daniel
Guten Abend
Leider komme ich nicht weiter. Mit meinem Code sollte es gefundene Zeilen in ein Tabellenblatt einfügen. Es dürfen sich max. 49 Zeilen auf einer Seite befinden.
Nun soll es prüfen, ob die gefunden Zeilen noch auf dem Blatt Platz haben. Wenn nicht, soll ein Seitenumbruch eingefügt werden.
Ich habe eine Beispieldatei hochgeladen.
Yal war so nett und hat mir dabei schon ein Beispiel gemacht. Doch leider funktioniert es nicht ganz wie ich es möchte & ich finde es dauert ein bisschen zu lange.
Damit ich als Anfänger mit dem Code auch zurecht komme, wäre es schön, wenn mein Code angepasst werden könnte. Dies kannst Du Yal ja vielleicht auch?
Besten Dank für Eure Hilfe und eine gute Nacht.
Gruss Daniel
https://www.herber.de/bbs/user/146683.xlsm
Anzeige
AW: Seitenumbruch einfügen
21.06.2021 11:48:55
Yal
Hallo Daniel,
anbei die angepasste Sub/Function: CommandButton1_Click + 2 neuen Functions:
Ich habe eine separaten Ermittlung der selektierten Elementen eingebaut. Darauf lässt sich auch prüfen, ob überhaupt was selektiert wurde.
Die Function "UBound0" ist nur notwendig, weil auf einen noch nicht dimensionierten Array die Function "UBound" einen Fehler zurückgibt. Den verwende ich um den Default-Wert "-1" zurückzugeben, sodass darauf immer "+1" gemacht wird, sonst muss man in der Funktion "Selektierte_auflisten" eine aufwändigen Ausnahmebehandlung einbauen.
Die Situation des "mehr als 49 Zeilen" lässt sich nur erzeugen, wenn RA, RB, RC, RD selektiert werden. Wenn man auf diesem Auswahl nochmal laufen lässt ohne das erste Ergebnis zu löschen, kann man sehen, dass es nicht nur für 49, sondern auch 98, 147, 196 usw. funktioniert.
Ich habe die Idee implementiert, dass Zeile für Zeile genauso schnell als ein Such-Mechanismus ist. Auf alle Fälle leichter in Code.
Ein Bischen Performanz lässt sich mit ScreenUpdating = False/True holen.

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim AnzahlTreffer  As Integer
Dim Liste_selektierten
Dim E, i
Dim Z As Range
Set ws = Worksheets("Lagerliste_drucken")
Liste_selektierten = Selektierte_auflisten("ListBox1")
If Ubound0(Liste_selektierten) = -1 Then
MsgBox "Bitte Auswahl treffen"
Exit Sub
End If
Application.ScreenUpdating = False
For Each E In Liste_selektierten
'Eine Seite sollte nicht mehr als 49 Zeilen erhalten!
'Prüfen ob die gefundenen Zeilen noch auf der Seite P0latz haben
'wenn ja, Überschriften eintragen und anschliessend die gefunden Zeilen
'wenn nicht, einen Zeilenumbruch einfügen und dann das ganze wiederholen bis die Auswahl in Listbox leer ist
AnzahlTreffer = WorksheetFunction.CountIf(Worksheets("WSCAR_Daten").Range("F:F"), E)
If AnzahlTreffer > 0 Then
Überschriften_Einfügen E       'Hier werden die Überschriften eingefügt
With Worksheets("WSCAR_Daten")
For Each Z In .Range(.Range("F1"), .Range("F9999").End(xlUp)).Cells
If Z.Value = E Then Z.EntireRow.Range("A1:E1").Copy Destination:=ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
'Kontroll: nächste Seite erreicht? (49, 98, 147, ...) dann überschrift einfügen
If (ws.Range("A9999").End(xlUp).Row Mod 49) = 0 Then Überschriften_Einfügen E
Next
End With
End If
Next
With Worksheets("Lagerliste_Drucken")
.Cells.RowHeight = 16
.Cells.EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Private Function Selektierte_auflisten(LBox As String)
Dim i
Dim A() As String
'Sammeln
With Me.Controls(LBox)
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve A(Ubound0(A) + 1)
A(UBound(A)) = .List(i)
End If
Next
End With
'Übergeben
Selektierte_auflisten = A
End Function
Private Function Ubound0(Arr) As Long
'liefert -1 bei nicht instanzierte Array
On Error Resume Next
Ubound0 = -1
Ubound0 = UBound(Arr)
End Function
VG
Yal
Anzeige
AW: Seitenumbruch einfügen
21.06.2021 12:52:22
Eberhard
Hallo Yal
Puh, da hast Du ja gearbeitet. Leider bekomme ich bei der Zeile

Überschriften_Einfügen E
die Fehlermeldung "Argumenttyp ByRef unverträglich!"
Gruss Daniel
oh ja..
21.06.2021 13:45:57
Yal
...da hast Du recht: es gab doch eine Änderung an einer anderen Stelle, und zwar

Function Überschriften_Einfügen(Suchen As String)
wird zu

Function Überschriften_Einfügen(ByVal Suchen As String)
eine Kleinigkeit, die dein Problem beseitigt.
Es liegt daran, dass E als Lauf-variable eines For Each-Schleife ein "Objekt" sein soll (wobei ich mit "als String" nicht probiert habe), aber dann wird versucht diese Variable ByRef zu übergeben. Geht bei String leider nicht.
VG
Yal
Anzeige
AW: oh ja..
21.06.2021 20:29:39
Daniel
Hallo Yal
Danke, jetzt funktioniert es fast perfekt. Wähle mal jeder Lagerort an. Am Schluss wird die Überschrift "Lagerort" nicht mehr auf die letzte Zeile geschrieben.
Ansonsten sieht es glaub ich super aus. Habe noch die Schriftgrösse auf 9 angepasst. So hat alles auch in der Breite Platz! :-)
Vielleicht kannst Du dieser kleine Schönheitsfehler noch korrigieren!
Gruss und einen schönen Abend.
Daniel
Je kleiner der Schrift, desto mehr Zeilen pr Seite
21.06.2021 22:05:54
Yal
Dann ist die Trennung nicht mehr nach 49 Zeilen sondern 52, oder 53. Da gibt es nur eine Stelle, wo der 49 zu korrigieren ist.
Ansonsten verstehe ich deine Frage nicht:
"Lagerort" nicht mehr auf die letzte Zeile geschrieben
?
VG
Yal
Anzeige
Überschrift
22.06.2021 07:01:23
Daniel
Guten Morgen Yal
Setze die Schriftgrösse mal auf 9. Wähle alle Lagerorte in der Listbox aus. Danach gehst Du auf das Tabellenblatt "Lagerliste_Drucken" und wählst Druckansicht aus.
Da siehst Du, dass die Überschriften zum Teil erscheinen aber keine weiteren Angaben darunter stehen. Oder bei der letzten Seite nur die Auflistung der Namen und darüber befindet sich keine Überschriften. Jedenfalls ist es bei mir so. Ansonsten versuche ich Dir mal ein Bild hochzuladen.
Wünsche einen schönen Tag.
Gruss Daniel
AW: Überschrift
22.06.2021 09:52:04
Yal
Hallo Daniel,
es ist kein Programmfehler, sondern ein Konzept-Fehler: es wird nur geprüft, ob die letzte übertragene Zeile auf einem Mehrfach von 49 liegt.
Wenn ja, wird der Überschrift übertragen. Egal, ob danach etwas kommt, oder -wie in dem Fall- nicht.
Ich könnte zwar nicht genau dein Zustand nachbauen, könnte aber innerhalb der Liste ein Überschrift finden ("RD"), der wiederholt wurde, obwohl keine Einträge mehr vorhanden waren.
Vielleicht kannst Du dir ein Vorgehensweise überlegen, wie man damit umgehen sollte.
VG
Yal
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige