MS-Office-Forum

Zurück   MS-Office-Forum > Microsoft Office > Microsoft Excel
Registrieren Forum Hilfe Alle Foren als gelesen markieren

Banner und Co.

Antworten
Ads
Themen-Optionen Ansicht
Alt 05.07.2019, 16:21   #1
WhoIsThis?
MOF User
MOF User
Standard VBA - Bei jedem Seitenumbruch Zeilen einfügen

Hallo zusammen,

ich mach hier jetzt schon seit Tagen an einem Problem rum und komm nicht weiter. Vielleicht kann mir einer von euch dabei helfen.

Beispieldatei im Anhang.

Per vba wird in einer langen Liste jeweils zum Seitenumbruch per Schleife eine Kopf- und Fußzeile eingefügt, so dass keine Bestellung auf einem Blatt abgeschnitten wird, sondern dann auf das nächste Blatt verschoben wird.

Dabei habe ich allerdings zwei Probleme:
1. Wenn ich in einem Makro die Seite formatieren und die Zeilen einfügen lasse funktioniert es nicht. Die eingefügten Zeilen der ersten Seite sind mitten in der Seite und erst ab der zweiten Seite an der richtigen Position. Rufe ich sie in getrennten Makros auf funktioniert es.

2. Durch die eingefügten Zeilen rutscht die letzte Zeile immer weiter aus der Schleife raus. Dadurch werden die letzten Seiten des Druckbereichs nicht mehr um meine Kopf- und Fußzeilen erweitert. Kann ich die Schleife irgendwie auch entsprechend um die neuen Zeilen erweitern? Bzw kann ich meine Schleife irgendwie so umbauen, dass es funktioniert?

Wäre über jede Hilfe sehr dankbar.

Danke und Gruß
Who.
Angehängte Dateien
Dateityp: xlsm Beispieldatei.xlsm (59,9 KB, 10x aufgerufen)
WhoIsThis? ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.07.2019, 18:37   #2
Klaus-Dieter
MOF Koryphäe
MOF Koryphäe
Standard

Hallo,

das wäre eine leicht Übung für Access. Hatte zwar gelegentlich Ansätze für Excel gesehen, so richtig funktionierte das aber alles nicht.

Summen für einzelne Blätter kann man mit Teilergebnis bekommen, aber den Übertrag?

__________________

<br>Viele Grüße Klaus-Dieter<br>
<a *****"http://excelwelt.eu/index.html"><img src="http://excelwelt.eu/Images/excelwelt.png" width=239 height=56 border=0 alt="Klaus-Dieter's Excel und VBA Seite">
Klaus-Dieter ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 05.07.2019, 20:21   #3
WhoIsThis?
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Klaus-Dieter,

Danke für deine Antwort. Ja genau. Leider ist unsere Firma sehr Excel basiert. daran arbeite ich noch ;-) Bis dahin muss ich es aber leider so lösen.
Summe und Übertrag sollte so auch kein Problem sein, das bekomme ich programmiert - hab auch schon ein paar Denkansätze dafür.
Mein Problem ist wirklich rein, dass auf den letzten Seiten keine Kopf- und Fußzeilen eingefügt werden, also die Schleife irgendwie erweitert wird.

Danke und Gruß
Michael
WhoIsThis? ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2019, 10:32   #4
drambeldier
MOF Koryphäe
MOF Koryphäe
Standard

Moin,

zu 1. kann ich nichts sagen. zu 2.: Mit der Anzahl der Pages könntest Du die Zeilen berechnen, die dazukommen, und das zur aktuellen Zeilenzahl addieren. Wird nicht ganz genau, weil die Bestellungen unterschiedliche Zeilenzahl haben, sollte aber schon mal in die Gegend führen.

__________________

Gruß
Ralf
drambeldier ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2019, 14:40   #5
hubert17
MOF User
MOF User
Standard

Hallo,

anbei mal mein Ansatz für dich:

Code:

Option Explicit

Private Sub ZeilenSetzen()
Dim wksBriefkopf As Worksheet
Set wksBriefkopf = Worksheets("Briefkopf")

Dim wksFußzeile As Worksheet
Set wksFußzeile = Worksheets("Kopf- und Fußzeile")
    
Dim letzte As Long
Dim lastBreak As Long
Dim HBreakX As HPageBreak
Dim HBreakR As Long
Dim LSvorHB As Long
Dim i As Long
Dim breaksCount As Long
    
    letzte = Cells(Rows.Count, 1).End(xlUp).Row
    Cells(letzte + 1, 1).Select
        
    breaksCount = Sheets("Briefkopf").HPageBreaks.Count
    
    i = 1
    Do While i <= breaksCount
        
        With wksBriefkopf.PageSetup 'Druckbereich setzen. Sonst findet Excel keine Seitenumbrüche?!
            .Zoom = False
            .FitToPagesWide = 1
            .PrintArea = "$A$1:$G$" & letzte
        End With
        
        HBreakR = Sheets("Briefkopf").HPageBreaks(i).Location.Row
        LSvorHB = Range(Cells(1, 1), Cells(HBreakR - 4, 1)).Find(What:="Ihre Bestellung", LookIn:=xlValues, Lookat:=xlPart, SearchDirection:=xlPrevious).Row '...die Position der letzten Bestellung vor dem Seitenumbruch auslesen und...

        letzte = Cells(Rows.Count, 1).End(xlUp).Row
        Range("A" & LSvorHB & ":G" & letzte).Cut Range("A" & HBreakR + 7) '...die restliche Rechnung nach unten verschieben.

        wksFußzeile.Rows("2:12").Copy 'Die Kopf- und Fußzeile aus dem extra Arbeitsblatt kopieren und...
        wksBriefkopf.Rows(HBreakR - 4).PasteSpecial xlPasteAll '...im Rechnungsblatt einfügen.
        
        letzte = Cells(Rows.Count, 1).End(xlUp).Row
        Cells(letzte + 1, 1).Select
        breaksCount = Sheets("Briefkopf").HPageBreaks.Count

    
        i = i + 1
    Loop
    
    ' letzte Fußzeile setzen
    lastBreak = Sheets("Briefkopf").HPageBreaks(breaksCount).Location.Row
    
    If letzte + 1 - lastBreak <= 64 - 5 Then
        wksFußzeile.Rows("2:5").Copy 'Die Kopf- und Fußzeile aus dem extra Arbeitsblatt kopieren und...
        wksBriefkopf.Rows(letzte + 2).PasteSpecial xlPasteAll
    
        With wksBriefkopf.PageSetup 'Druckbereich setzen. Sonst findet Excel keine Seitenumbrüche?!
            .Zoom = False
            .FitToPagesWide = 1
            .PrintArea = "$A$1:$G$" & letzte + 5
        End With
    
    End If
    
End Sub
die Sub "RechnungFormatieren()" habe ich mit in der Sub "ZeilenSetzen()" integriert und benötigst du somit nicht mehr.

Den Bereich unterm Kommentar " ' letzte Fußzeile setzen" musst du gegebenenfalls noch anpassen und probieren, wie das mit der letzten Seite passt.

__________________

Gruß
Hubert
hubert17 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 08.07.2019, 19:05   #6
WhoIsThis?
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Hubert,

danke, für den Code. Ich bin morgen wieder im Büro und werd es dann mal ausprobieren. Werde natürlich eine Rückmeldung dazu posten, inwieweit es funktioniert. :-)

Danke für eure Hilfe!
Michael
WhoIsThis? ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.07.2019, 12:11   #7
WhoIsThis?
Threadstarter Threadstarter
MOF User
MOF User
Standard

Hallo Hubert,

sorry hab jetzt erst geschafft es zu testen.
Leider hab ich mit deinem Loop das gleiche Problem wie mit meinen Ansätzen - die neuen Seiten die durch das verschieben oder einfügen der Zeilen erstellt werden sind nicht mehr im Loop oder der Schleife eingeschlossen. Dadurch bekommen sie auch keine Kopf- und Fußzeile.
Hast du eine Idee dazu?

Danke und Gruß
Michael
WhoIsThis? ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.07.2019, 12:35   #8
hubert17
MOF User
MOF User
Standard

also bei mir funktioniert es, anbei deine Datei.
Angehängte Dateien
Dateityp: xlsm Beispieldatei.xlsm (53,1 KB, 3x aufgerufen)

__________________

Gruß
Hubert
hubert17 ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Alt 11.07.2019, 15:40   #9
WhoIsThis?
Threadstarter Threadstarter
MOF User
MOF User
Standard

Komisch, jetzt hats bei mir auch funktioniert.
Ich vermute es lag daran, dass ich in meiner Datei diesen Teil am Anfang weggelassen habe:
Code:

    With wksBriefkopf.PageSetup 'Druckbereich setzen. Sonst findet Excel keine Seitenumbrüche?!
            .Zoom = False
            .FitToPagesWide = 1
            .PrintArea = "$A$1:$G$" & letzte
        End With
Und gehofft hatte, dass es reicht wenn ich den Druckbereich einfach aufhebe.
Mit deiner Variante hat es jetzt aber einwandfrei funktioniert.
Vielen Dank für deine Hilfe.

Gruß
Michael
WhoIsThis? ist offline  
verlinken auf Del.icio.us Diese Seite zu Mister Wong hinzufügen
Antworten Auf Beitrag antworten
Ads
Antworten


Aktive Benutzer in diesem Thema: 1 (Registrierte Benutzer: 0, Besucher: 1)
 
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge anzufügen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

vB Code ist An.
Smileys sind An.
[IMG] Code ist An.
HTML-Code ist An.
Gehe zu


Alle Zeitangaben in WEZ +1. Es ist jetzt 04:46 Uhr.



Powered by: vBulletin Version 3.6.2 (Deutsch)
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.

Copyright ©2000-2018 MS-Office-Forum. Alle Rechte vorbehalten.
Copyright ©Design: Manuela Kulpa ©Rechte: Günter Kramer
Eine Verwendung der Inhalte in anderen Publikationen, auch auszugsweise,
ist ohne ausdrückliche Zustimmung der Autoren nicht gestattet.