Office: Problem mit meinem VBA bzw Makro

Hallo Achim.

Ich habe jetzt die Kopierten Daten wieder raus gemacht und habe nun festgestellt das er mir mit diesem Code:

Code:

Option Explicit

Sub Listendruck()

Dim loLastRow As Long
Dim loCounter As Long

    Application.ScreenUpdating = False
    With Worksheets("Maschinen Liste")
        .Visible = True
    ' letzte benutzte Zelle in Spalte 1 ermitteln = Startwert für die folgende Schleife
        loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    ' Schleife um die letzte Zelle in Spalte 1 mit einem Wert zu finden
        For loCounter = loLastRow To 1 Step -1
            If .Cells(loCounter, 1).Text <> "" Then
                loLastRow = loCounter
                Exit For
            End If
        Next loCounter
    ' Druckbereich auf die Spalten A-G festlegen
        .PageSetup.PrintArea = "$A:$G"
    ' Schleife um letzten Seitenumbruch vor loLastRow zu finden
        If .HPageBreaks.Count > 0 Then
            loCounter = 1
            Do
                If (.HPageBreaks(loCounter).Location.Row - 1) > (loLastRow - .HPageBreaks(1).Location.Row) Then
                ' letzte Zeile manuell festlegen
                    loLastRow = .HPageBreaks(loCounter).Location.Row + .HPageBreaks(1).Location.Row - 2
                    Exit Do
                Else
                    loCounter = loCounter + 1
                End If
            Loop
        ' Druckbereich festlegen
            .PageSetup.PrintArea = "$A$1:$G$" & loLastRow
            .PrintOut
        Else
        ' eine Seite drucken
            .PrintOut From:=1, To:=1
        End If
        .Visible = False
    End With
    Application.ScreenUpdating = True
    
End Sub

Die ersten drei Seiten druckt wobei auf der 3.ten Seite nur eine Leerh Zeile ist. Die erste Seite ist voll mit Daten die zweite Seite etwa nur 3/4 voll ist ist mit Daten die restlichen Zellen sind leer wie es sein soll nur warum macht er mir ne dritte Seite mit nur einer lerren Zelle. Habe es mit den beiden letzen Codes von Dir versucht und bei beiden ist das selbe Problem.

Gruß Michael


Wasmache ich da falsch


Habe Festgestellt das immer ein Druckbereich Festgelegt wird die Zeilen dan gleich pro Blatt nur druckt er dann auch ein 3. Seite. Wenn ich den Druckbereich mit der Handfestlege dann klappt das nur dann habe ich auf einer Seite mehr Zeilen auf der anderen weniger. Wenn ich dann den Druckbereich lösche und wieder über das Makro drucke dann habe ich wieder 3 Seiten wobei auf Seite 3 nur eine Zeille ist die keine Daten hat.


Wenn Du mir mal Deine E-Mail Adresse geben könntest würde ich Dir die Mappe gerne mal zu Senden.

 

Hallo Michael,

so sollte es jetzt eigentlich klappen (hatte wohl nen Gedankenfehler):

Code:

Option Explicit

Sub Listendruck()

Dim loLastRow As Long
Dim loCounter As Long

    With Worksheets("Maschinen Liste")
        .Visible = True
    ' letzte benutzte Zelle in Spalte 1 ermitteln = Startwert für die folgende Schleife
        loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    ' Schleife um die letzte Zelle in Spalte 1 mit einem Wert zu finden
        For loCounter = loLastRow To 1 Step -1
            If .Cells(loCounter, 1).Text <> "" Then
                loLastRow = loCounter
                Exit For
            End If
        Next loCounter
    ' Druckbereich auf die Spalten A-G festlegen
        .PageSetup.PrintArea = "$A:$G"
    ' Schleife um letzten Seitenumbruch vor loLastRow zu finden
        If .HPageBreaks.Count > 0 Then
            loCounter = 1
            Do
                If (.HPageBreaks(loCounter).Location.Row - 1) >= loLastRow Then
                ' letzte Zeile manuell festlegen
                    loLastRow = .HPageBreaks(loCounter).Location.Row - 1
                    Exit Do
                Else
                    loCounter = loCounter + 1
                End If
            Loop
        ' Druckbereich festlegen
            .PageSetup.PrintArea = "$A$1:$G$" & loLastRow
            .PrintOut
        Else
        ' eine Seite drucken
            .PrintOut From:=1, To:=1
        End If
        .Visible = False
    End With
    
End Sub

Das "Application.ScreenUpdating = False" habe ich weggelassen, da es bei mir teilweise Probleme verursacht.
Ich würde Dir raten es genauso weg zu lassen.


Da die Seitenumbrüche von Excel automatisch gesetzt werden, gehe ich davon aus, das die ersten Zeilen bei Dir eine andere Höhe haben als der Rest.
Ich vermute deshalb sind auf der ersten Seite weniger Zeilen als auf den anderen.
Wenn dies zutrifft, dann passen bei der entsprechenden Zoomstufe einfach nicht mehr auf eine Seite.
Das mit der letzten Seite sollte jetzt behoben sein.


Zu Deinem Wunsch die Zeilenanzahl pro Seite auf 45 festzulegen:
Das ist machbar, den Code schreibe ich Dir am Wochenende.
Ob dies sinnvoll ist, ist ne andere Frage, denn wenn die 45 Zeilen nicht aufs Blatt passen, dann gehen die Probleme wieder von vorne los.
Deshalb habe ich bisher die Umbrüche von Excel automatisch setzen lassen.


Die Beispieldatei:
Mache bitte eine Kopie Deiner Datei, lösche alle Blätter außer dem welches gedruckt werden soll, und dem auf das sich die Formeln in Spalte A beziehen.
10 - 15 Zeilen an Daten reichen auch, und es können sinnlose Dummys sein, falls Du Datenschutzbedenken hast.
Diese Kopie lade bitte hier im Forum als Anhang zu einer Antwort hoch.
Dann sehen wir endlich klarer.

 

Hallo Achim

Die erste Zeile ist gößer als die anderen aber sie ist als Drucktikel festgelegt und wir Automatisch auf jeder Seite mit gedruckt und sie ist fixiert. Ich habe es probiert es passen mehr als 45 drauf aber Sicherheitshalber können wir 42 machen die Passen jetzt schon drauf wenn excel das macht.


Das mit dem Hochladen klappt einfach nicht ist einfach zu groß. Habe die Datei auf meinem Server hochgeladen und hier der Link.

http://dj-black-snake.de/Maschienen-Verwaltung.zip

Werde die Datei später löschen wenn Du Sie hast. Schau Dich da nur nicht so um ist alles noch etwas durcheinander esmal muß alles laufen bis das ich anfange am Aussehen rum zu Bastelln.


Danke Dir nochmal Achim bist mein Held. Was hätte ich nur ohne Dich gemacht.

 

Hallo Michael,

es wäre schön gewesen, wenn Du eine Beispieldatei hier im Forum hochgeladen hättest.
Wenn Du (wie ich es ja geschrieben habe) die Datei auf 2 Blätter reduziert hättest (so wie Deine "Maschienen Verwaltung (office07).xlsm") und dort dann alles außer den ersten 20 Datenzeilen gelöscht hättest, dann wäre die Datei nur gute 30 KB groß und Du hättest sie ohne Probleme hier anhängen können.
Da aber in Deiner Datei Original-Daten stehen, und ich keine Lust zum anonymisieren habe, hänge ich sie nicht selber an.
Schade, denn so nimmst Du anderen die Möglichkeit, das Problem und den Lösungsweg nach zu vollziehen.



Zum Problem:

Wichtig ist, dass Du die Bildschirmaktualisierung nicht ausschaltest, denn dies führt ansonsten zu Problemen.

Ich habe den Code dahingehen geändert, dass zuerst alle eventuell vorhandenen manuellen Seitenumbrüche gelöscht werden.
Danach werden alle senkrechten Umbrüche nach rechts verschoben, wodurch sich natürlich die Zoomstufe des Druckes anpasst. Dazu ist übrigens die Ansicht "Umbruchvorschau" notwendig, ansonsten gibt es einen Laufzeitfehler. Die Ansicht wird später aber wieder auf "normal" zurückgesetzt. Ziel der Verschiebung ist, den Druck nur eine Seite breit zu haben.
Da Excel die horizontalen Seitenumbrüche automatisch setzt, sind immer gleich viele Zeilen auf jeder Seite (außer die Zeilen sind nicht alle gleich hoch). Die erste Zeile, die Du als Wiederholungszeile eingetragen hast, wird dabei berücksichtigt, macht also keine Probleme.
Wieviele Zeilen jetzt pro Seite gedruckt werden können, hängt also davon ab, wie breit die Spalten des Druckbereiches sind (je breiter, desto kleiner der Druck, desto mehr Zeilen pro Seite), und wie Deine sonstigen Druckeinstellungen aussehen (Seitenränder, Wiederholungszeilen etc.).

Bei der Ermittlung des Druckbereiches habe ich die Prüfung um die Schleife wieder entfernt, weil sie unnötig ist.


Da diese Lösung variabel funktioniert, habe ich mich dagegen entschieden noch den Code für eine festgelegte Zeilenanzahl pro Seite zu schreiben. Ich sehe in diesem Fall keinen Sinn darin, wohl aber potenzielle Probleme.

Code:

Option Explicit

Sub Listendruck()

Dim loLastRow As Long
Dim loCounter As Long

    With Worksheets("Maschinen Liste")
        .Visible = True
    ' letzte benutzte Zelle in Spalte 1 ermitteln = Startwert für die folgende Schleife
        loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    ' Schleife um die letzte Zelle in Spalte 1 mit einem Wert zu finden
        For loCounter = loLastRow To 1 Step -1
            If .Cells(loCounter, 1).Text <> "" Then
                loLastRow = loCounter
                Exit For
            End If
        Next loCounter
[COLOR=#ff0000]    ' alle Seitenumbrüche entfernen
        ActiveWindow.View = xlPageBreakPreview
        .ResetAllPageBreaks
        For loCounter = .VPageBreaks.Count To 1 Step -1
            .VPageBreaks(loCounter).DragOff Direction:=xlToRight, RegionIndex:=1
        Next loCounter
    ' Druckbereich auf die Spalten A-G festlegen, eine Seite breit
        With .PageSetup
            [/COLOR].PrintArea = "$A:$G"[COLOR=#ff0000]
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With[/COLOR]
    ' Schleife um den ersten Seitenumbruch nach loLastRow zu finden
        loCounter = 1
        Do
            If (.HPageBreaks(loCounter).Location.Row - 1) >= loLastRow Then
            ' letzte Zeile manuell festlegen
                loLastRow = .HPageBreaks(loCounter).Location.Row - 1
                Exit Do
            Else
                loCounter = loCounter + 1
            End If
        Loop
        .PageSetup.PrintArea = "$A$1:$G$" & loLastRow
        .PrintOut
        [COLOR=#ff0000]ActiveWindow.View = xlNormalView[/COLOR]
        .Visible = False
    End With
    
End Sub

Ich hoffe geholfen zu haben.

 

Hallo Achim.

Danke Dir nochmal für die Hilfen ur leider gibt es da ein kleines Problem.

Laufzeitfehler '1004':

Anwendungs- oder objektdefinierter Fehler.


Bei Klick auf "Debuggen"

ist folgennde Zeile Gelb hinterlegt:

.VPageBreaks(loCounter).DragOff Direction:=xlToRight, RegionIndex:=1


Da ich die Seite von der Abfragekarte aus aufrufen möchte wird die Seite bearbeitet und haben dann die Umbruchvorschau akticiert. Aber in der Tabelle "Maschinen Liste" passiert nichts. Was mache ich nur falsch. Muß ich noch etwas eintragen in den Code?

Ich habe nun mal die Datei Angehängt habe ein Teil der Daten drin gelassen. Alles andere gelöscht.

Gruß Michael

 

Hallo Michael,

sorry, mein Fehler. Das hatte ich vergessen:

Code:

Option Explicit

Sub Listendruck()

Dim loLastRow As Long
Dim loCounter As Long
[COLOR=#ff0000]Dim strSheetName As String
strSheetName = ActiveSheet.Name[/COLOR]

    With Worksheets("Maschinen Liste")
        .Visible = True
        [COLOR=#ff0000].Activate[/COLOR]
    ' letzte benutzte Zelle in Spalte 1 ermitteln = Startwert für die folgende Schleife
        loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    ' Schleife um die letzte Zelle in Spalte 1 mit einem Wert zu finden
        For loCounter = loLastRow To 1 Step -1
            If .Cells(loCounter, 1).Text <> "" Then
                loLastRow = loCounter
                Exit For
            End If
        Next loCounter
    ' alle Seitenumbrüche entfernen
        ActiveWindow.View = xlPageBreakPreview
        .ResetAllPageBreaks
        For loCounter = .VPageBreaks.Count To 1 Step -1
            .VPageBreaks(loCounter).DragOff Direction:=xlToRight, RegionIndex:=1
        Next loCounter
    ' Druckbereich auf die Spalten A-G festlegen, eine Seite breit
        With .PageSetup
            .PrintArea = "$A:$G"
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With
    ' Schleife um den ersten Seitenumbruch nach loLastRow zu finden
        loCounter = 1
        Do
            If (.HPageBreaks(loCounter).Location.Row - 1) >= loLastRow Then
            ' letzte Zeile manuell festlegen
                loLastRow = .HPageBreaks(loCounter).Location.Row - 1
                Exit Do
            Else
                loCounter = loCounter + 1
            End If
        Loop
        .PageSetup.PrintArea = "$A$1:$G$" & loLastRow
        .PrintOut
        ActiveWindow.View = xlNormalView
        .Visible = False
    End With
    [COLOR=#ff0000]Worksheets(strSheetName).Activate[/COLOR]
    
End Sub

 

Hallo Achim.


Super das klappt nun genau so wie ich mir das vorgestellt haben einfach nur klasse. Ich danke Dir tausendmal einfach spitze.

Ich habe noch etwas geändert!

Code:

Private Sub CommandButton2_Click()


Dim loLastRow As Long
Dim loCounter As Long

Application.ScreenUpdating = False <--- [B][COLOR="#FF0000"]Das hier eingfügt[/COLOR][/B]
Dim strSheetName As String
strSheetName = ActiveSheet.Name
    With Worksheets("Maschinen Liste")
    .Visible = True
        .Activate
        ' letzte benutzte Zelle in Spalte 1 ermitteln = Startwert für die folgende Schleife
        loLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        ' Schleife um die letzte Zelle in Spalte 1 mit einem Wert zu finden
        For loCounter = loLastRow To 1 Step -1
        If .Cells(loCounter, 1).Text <> "" Then
        loLastRow = loCounter
        Exit For
        End If
        Next loCounter
        ' alle Seitenumbrüche entfernen
        ActiveWindow.View = xlPageBreakPreview
        .ResetAllPageBreaks
        For loCounter = .VPageBreaks.Count To 1 Step -1
        .VPageBreaks(loCounter).DragOff Direction:=xlToRight, RegionIndex:=1
        Next loCounter
        ' Druckbereich auf die Spalten A-G festlegen, eine Seite breit
        With .PageSetup
        .PrintArea = "$A:$G"
        .FitToPagesWide = 1
        .FitToPagesTall = False
        End With
        ' Schleife um den ersten Seitenumbruch nach loLastRow zu finden
        loCounter = 1
        Do
        If (.HPageBreaks(loCounter).Location.Row - 1) >= loLastRow Then
        ' letzte Zeile manuell festlegen
        loLastRow = .HPageBreaks(loCounter).Location.Row - 1
        Exit Do
        Else
        loCounter = loCounter + 1
        End If
        Loop
        .PageSetup.PrintArea = "$A$1:$G$" & loLastRow
        .PrintOut
        ActiveWindow.View = xlNormalView
        .Visible = False
        End With
        Worksheets(strSheetName).Activate
            Application.ScreenUpdating = True <------- [B][COLOR="#FF0000"]Das hier eingefügt
[/COLOR][/B]
        End Sub

Eine Super Arbeit ich hätte das niemals hinbekommen.



Vielen vielen Dank an Achim.


Gruß Michael

 

Hallo Achim!

Vieleicht könntest Du mir da auch mal etwas helfen.

http://www.office-hilfe.com/support/showthread.php/17333-Makro-geht-nicht-so-wie-es-soll


Dabke.



Gruß Michael

 

Hallo Michael,

sry, im Moment habe ich dafür keine Zeit.


Gruß Achim

 

Ok Danke Achim