Servus,
kann mir bitte jemand erklären warum VBA das einfügen der manuellen Seitenumbrüche nicht interessiert.
(Keine Fehlermeldung aber auch kein Löschen der Seitenumbrüche bzw. einfügen der manuellen Seitenumbrüche).
Ziel: über u.a. Eingaben eine gleichmäßige Verteilung der Spalten und Zeilen beim Drucken zu erreichen
Danke.

Projekt_Details

AY AZ BA BB BC BD BE BF BG BH BI BJ BK BL BM BN BO BP BQ BR BS BT BU 4                                               5   Druckoptionen         6   S. Breit: 3   S. Hoch: 1   Drucker: Adobe PDF         7

Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  



strWiederholung(0) = "$D:$F" 'Wiederholungsspalten

    strWiederholung(1) = "$10:$16" 'Wiederholungszeilen

    lngSpalten(0) = Range("H11").Column 'Erste Spalte des Drucks festlegen

    lngSpalten(1) = Range("B19").Value 'letzte Spalte des Drucks festlegen (letzte Spalte ohne Fehler in der KW Berechnung)

    lngZeilen(0) = Range("D17").Row: lngZeilen(1) = Range("D77").Row '(0)Erste Zeile (1)Letzte Zeile

    intSeiten(0) = Range("BC6").Value: intSeiten(1) = Range("BH6").Value  '(0)Seiten breit (1)S. hoch

    intLoop(0) = (lngSpalten(1) - lngSpalten(0)) / intSeiten(0) 'Anzahl Spalten pro Seite breit

    intLoop(1) = (lngZeilen(1) - lngZeilen(0)) / intSeiten(1) 'Anzahl Zeilen pro Seite hoch



    For intZ = 1 To intSeiten(0) 'Seiten breit



        ReDim Preserve intSeiten_Sp(1, intZ - 1)

        If intZ = 1 Then        'Erste Seite

            intSeiten_Sp(0, intZ - 1) = lngSpalten(0)

            intSeiten_Sp(1, intZ - 1) = Round(intSeiten_Sp(0, intZ - 1) + intLoop(0) - IIf(intSeiten(0) = 1, 0, 1), 0)

        ElseIf intZ = intSeiten(0) Then 'Letzte Seite = x

            intSeiten_Sp(0, intZ - 1) = intSeiten_Sp(1, intZ - 2) + 1

            intSeiten_Sp(1, intZ - 1) = lngSpalten(1)

        ElseIf intZ > 1 Then        'Sonstige Seiten = 2 bis x - 1

            intSeiten_Sp(0, intZ - 1) = intSeiten_Sp(1, intZ - 2) + 1

            intSeiten_Sp(1, intZ - 1) = Round(intSeiten_Sp(0, intZ - 1) + intLoop(0) - 1, 0)

        End If

    Next



    For intZ = 1 To intSeiten(1) 'Seiten hoch

        ReDim Preserve intSeiten_Ze(1, intZ - 1)

        If intZ = 1 Then        'Erste Seite

            intSeiten_Ze(0, intZ - 1) = lngZeilen(0)

            intSeiten_Ze(1, intZ - 1) = Round(intSeiten_Ze(0, intZ - 1) + intLoop(1) - IIf(intSeiten(1) = 1, 0, 1), 0)

        ElseIf intZ = intSeiten(1) Then 'Letzte Seite = x

            intSeiten_Ze(0, intZ - 1) = intSeiten_Ze(1, intZ - 2) + 1

            intSeiten_Ze(1, intZ - 1) = lngZeilen(1)

        ElseIf intZ > 1 Then        'Sonstige Seiten = 2 bis x -1

            intSeiten_Ze(0, intZ - 1) = intSeiten_Ze(1, intZ - 2) + 1

            intSeiten_Ze(1, intZ - 1) = Round(intSeiten_Ze(0, intZ - 1) + intLoop(1) - 1, 0)

        End If



        For intC = 0 To UBound(intSeiten_Sp, 2)

            ReDim Preserve rngDruck(arrC)

            'Set rngDruck(arrC) = Range(Cells(intSeiten_Ze(0, intZ - 1), intSeiten_Sp(0, intC)), _

                                    Cells(intSeiten_Ze(1, intZ - 1), intSeiten_Sp(1, intC))) '--> auch schon probiert

            Set rngDruck(arrC) = Range(Cells(intSeiten_Ze(1, intZ - 1), intSeiten_Sp(1, intC)), _

                                        Cells(intSeiten_Ze(1, intZ - 1), intSeiten_Sp(1, intC)))

            'MsgBox rngDruck(arrC).Address(0, 0)

            arrC = arrC + 1

        Next

    Next



    With ActiveSheet.PageSetup

        .PrintTitleRows = strWiederholung(1)

        .PrintTitleColumns = strWiederholung(0)

        .PrintArea = "$C$9:$CU$77"

    End With



    ActiveSheet.Cells.PageBreak = xlPageBreakNone 'Alle Seitenumbrüche löschen

    'Seitenumbrüche neu (nach Eingabe) zuordnen

    For intC = 0 To UBound(rngDruck)

        'rngDruck.PageBreak = xlPageBreakManual '--> Funktioniert auch nicht

        ActiveSheet.Columns((rngDruck(intC).Column)).PageBreak = xlPageBreakManual

        ActiveSheet.Rows((rngDruck(intC).Row)).PageBreak = xlPageBreakManual

    Next


MfG Peter