Seitenumbruch über VBA variable halten

  • #1
S

Splizz

Aktives Mitglied
Themenersteller
Dabei seit
21.03.2005
Beiträge
25
Reaktionspunkte
0
Hallo Leute ;D

Ich habe ein Problem. Schaut euch mal meine Beispieldatei an. Ist es irgendwie möglich das der Seitenumbruch nach dem letzten ganzen Datensatz vollzogen wird? Es geht vor allem daraum das zu automatisieren. In meiner richtigen Datei sind es immer unterschiedlich viele Zeilen pro Datensatz, von daher müsste man das dann immer händlisch machen. Ist es also möglich den Seitenumbruch nach dem letzten Datensatz durchzuführen den er richtig darstellen kann?

Beispieldatei:

Mein Dank ist euch Gewiss
Gruss
Splizz
 
  • #2
Hallo

Ein machbar oder nicht machbar würde mir schon wesentlich weiterhelfen...
Versteht ihr wie ich das meine?

gruss
Splizz
 
  • #3
Hallo Splizz,

ist machbar  ;D

Gruß Matjes  ;)

z.B. so:
Code: 
Sub SeitenumbruchVollstaendigeDatensaetz()
 ->Datensatzanfang ist gekennzeichnet durch
 ->Datum in Spalte A, sonnst ist Spalte A leer
 ->Aufgabe des Makros ist festzustellen,
 ->ob bei eingestelltem Drucker ein Datensatz
 ->gesplittet ausgedruckt wird
 ->In diesem Fall wird oberhalb diese Datensatzes
 ->ein Seitenumbruch eingefügt
 ->(wenn man das immer wieder machen will und sich
 -> die Zeilenanzahl der Datensätze verändert,
 -> müssen vorher eventuell vorhandene
 -> Seitenumbrüche gelöscht werden.)
  
  Const c_SPDatensatzAnfang = 1-> Spalte A
  Const c_ZMinZeile = 5->
  
  Dim ws As Worksheet
  Dim x As Long, z As Long, l_aktH As Long
  Dim l_Zeile As Long, l_Spalte As Long, l_Zeile_DAnf
  
  Set ws = ActiveSheet
  
 ->prüfen, ob noch manuelle Zeilenumbrüche vorhanden sind
  For x = ActiveSheet.HPageBreaks.Count To 1 Step -1
    If ActiveSheet.HPageBreaks(x).Type = xlPageBreakManual Then
      MsgBox ( _
      Es existieren manuell gesetzte Zeilenumbrüche auf dem Tabellenblatt _
      & vbLf & Bitte entfernen Sie diese.)
      GoTo Aufraeumen
    End If
  Next
  
  Do While 0 < ws.HPageBreaks.Count
    For x = 1 To ws.HPageBreaks.Count
      l_Zeile = ws.HPageBreaks(x).Location.Row
     ->Nachschauen, ob bei dieser Zeile gerade ein
     ->neuer Datensatz anfängt
      If ws.Cells(l_Zeile, c_SPDatensatzAnfang).Value =  Then
       ->Zeile ist nicht Datensatzanfang
        
       ->Datensatzanfang suchen
        For z = l_Zeile - 1 To c_ZMinZeile Step -1
          If ws.Cells(z, c_SPDatensatzAnfang).Value <>  Then
           ->DatensatzAnfang gefunden
            l_Zeile_DAnf = z: Exit For
          End If
        Next
        
       ->Seitenumbruch setzen
        ws.Cells(l_Zeile_DAnf, 1).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add _
                                  Before:=ActiveCell
        Exit For-> Seitenumbruch hat sich verändert
      End If
      
     ->Ende erreicht ?
      If x = ActiveSheet.HPageBreaks.Count Then
        MsgBox (Ist vollbracht :-))
        GoTo Aufraeumen
      End If
    Next
  Loop
Aufraeumen:
  Set ws = Nothing
End Sub
Sub AlleManuellenSeitenumbruecheLoeschen()
  Dim x As Long
  For x = ActiveSheet.HPageBreaks.Count To 1 Step -1
    If ActiveSheet.HPageBreaks(x).Type = xlPageBreakManual Then
      ActiveSheet.HPageBreaks(x).Delete
    End If
  Next
End Sub
 
  • #4
Hi, Danke für den Code...

Steig da leider nicht komplett durch!

Beim ausführen bleibt er bei :

Code: 
If ActiveSheet.HPageBreaks(x).Type = xlPageBreakManual Then

hängen.

INHALT AUSSERHALB DES GÜLTIGEN BEREICHS...

Ne, Idee was falsch ist?

ciao Splizz
 
  • #5
Also in der Testdatei klappt es... Hmm, nur warum nicht in der normalen? :'(
 
  • #6
ist das Makro für 1800 Zeilen vorgesehen?^^
 
  • #7
Hi Splizz,

kannst Du mir die Datei schicken. Dann könnte ich sehen, was ich nicht berücksichtigt habe. So hab ich erstmal keine Idee.  :'(

ggf. Inhalte durch Dummys ersetzen, falls geheim

Die Zeilenanzahl sollte dem Makro eigentlich egal sein.

Gruß Matjes :)
 
  • #8
Ok, ich schicke es dir gleich mal zu, nachdem ich die Datei entschärft habe...
 
  • #9
Weiß zwar nicht warum, aber ist ein ganz schöner Brocken!

2,5 M!!! ???
 
  • #10
Hi Fire-X,

so ich hab den Makro noch ein klein wenig modifiziert.

Die Zeilenumbrüche werden jetzt zwanghaft gelöscht, d.h. es ist jetzt nicht mehr notwendig das Einzel-Makro zum löschen der manuellen Seitenumbrüche zu verwenden.

In deiner Datei waren einige Seitenumbrüche, zu denen kein Type vorhanden war.
Ist schon merkwürdig  :-\

Die Konsanten-Definition der ersten Wertezeile hab ich auf 9 geändert- das entspricht deiner Datei.

Gruß Matjes :)

Code: 
Sub SeitenumbruchVollstaendigeDatensaetz()
 ->Datensatzanfang ist gekennzeichnet durch
 ->Datum in Spalte A, sonnst ist Spalte A leer
 ->Aufgabe des Makros ist festzustellen,
 ->ob bei eingestelltem Drucker ein Datensatz
 ->gesplittet ausgedruckt wird
 ->In diesem Fall wird oberhalb diese Datensatzes
 ->ein Seitenumbruch eingefügt
 ->
 -> Seitenumbrüche werden am Anfang des
 -> Makros gelöscht !!!
  
  Const c_SPDatensatzAnfang = 1-> Spalte A
  Const c_ZMinZeile = 9->
  
  Dim ws As Worksheet
  Dim x As Long, z As Long, l_aktH As Long
  Dim l_Zeile As Long, l_Spalte As Long, l_Zeile_DAnf
  
  Set ws = ActiveSheet
  
 ->
  On Error Resume Next
  For x = 1 To ActiveSheet.HPageBreaks.Count
    ActiveSheet.HPageBreaks(x).Delete
  Next
  
  
  Do While 0 < ws.HPageBreaks.Count
    For x = 1 To ws.HPageBreaks.Count
      l_Zeile = ws.HPageBreaks(x).Location.Row
     ->Nachschauen, ob bei dieser Zeile gerade ein
     ->neuer Datensatz anfängt
      If ws.Cells(l_Zeile, c_SPDatensatzAnfang).Value =  Then
       ->Zeile ist nicht Datensatzanfang
        
       ->Datensatzanfang suchen
        For z = l_Zeile - 1 To c_ZMinZeile Step -1
          If ws.Cells(z, c_SPDatensatzAnfang).Value <>  Then
           ->DatensatzAnfang gefunden
            l_Zeile_DAnf = z: Exit For
          End If
        Next
        
       ->Seitenumbruch setzen
        ws.Cells(l_Zeile_DAnf, 1).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add _
                                  Before:=ActiveCell
        Exit For-> Seitenumbruch hat sich verändert
      End If
      
     ->Ende erreicht ?
      If x = ws.HPageBreaks.Count Then
        MsgBox (Ist vollbracht :-))
        GoTo Aufraeumen
      End If
    Next
  Loop
Aufraeumen:
  Set ws = Nothing
End Sub
 
  • #11
Kannst mich auch Splizz nennen^^ ;D
 
  • #12
Ich ralls vóll net, es klappt wieder nicht in der richtigen Datei, Ich danke dir trotzdem... Ich werde mich nach dem Wochenende nochmal mit der Sache auseinandersetzen...

Das Problem ist in diesem Fall, dass bis zum 3 Seitenumbruch alles hinaut, keine Fehlermeldung kommt, er aber danach nicht richtig weitermacht, sondern die Seitenumbrücke wahrlos setzt. Ich melde mich am Montag oder so nochmal wie es aussieht. Ich versteh nicht warum der das macht. Ich seh keine Begrenzung oder sowas das er nur das ganze auf 600 Zeilen bezieht...

naja, bis denne, schönes wochenende

ciao Splizz
 
  • #13
hi

sorry, dass ich kein feedback gegen habe. War nicht machbar. Bedauerlicherweise funktioniert dein Makro jetzt weder in der Testdatei noch in der richtigen. Er zeigt zwar an, dass es vollbracht ist, aber leider ist das nicht der fall. Er macht gerade mal den ersten Seitenumbruch richtig und den rest dann warlos...

Hast du bzw Ihr noch eine Idee?
thx, Splizz
 
  • #14
hmm, keiner mehr ne Idee?

matjes etc.?

pls, wäre echt wichtig...

Danke Splizz
 
  • #15
Hi splizz,

bin noch am Knobeln, wie man das Problem einkreisen kann.
Melde mich heute abend nochmal.

Gruß Matjes :)
 
  • #16
Also jetzt das funktionierende Endresultat  :)

Gruß Matjes  :)

Code: 
Sub SeitenumbruchVollstDatensaetze()
 ->Datensatzanfang ist gekennzeichnet durch
 ->Datum in Spalte A, sonnst ist Spalte A leer
 ->Aufgabe des Makros ist festzustellen,
 ->ob bei eingestelltem Drucker ein Datensatz
 ->gesplittet ausgedruckt wird
 ->In diesem Fall wird oberhalb diese Datensatzes
 ->ein Seitenumbruch eingefügt
 ->
 -> Seitenumbrüche werden am Anfang des
 -> Makros gelöscht !!!!!!
  
  Const c_SPDatensatzAnfang = 1-> Spalte A
  Const c_ZMinZeile = 9->
  
  Dim ws As Worksheet, s_StatusbarRetten As String
  Dim x As Long, z As Long, l_Zeile_letzterUmbruch As Long
  Dim l_Zeile As Long, l_Spalte As Long, l_Zeile_DAnf As Long
  
  
  s_StatusbarRetten = Application.StatusBar
  Set ws = ActiveSheet
 ->Alle manuellen Zeilenumbrüche löschen
  ws.ResetAllPageBreaks
  
  ActiveWindow.View = xlPageBreakPreview
  
  l_Zeile_letzterUmbruch = 0
  Do While 0 < ws.HPageBreaks.Count
    For x = 1 To ws.HPageBreaks.Count
      l_Zeile = ws.HPageBreaks(x).Location.Row
      If l_Zeile > l_Zeile_letzterUmbruch Then
       ->Nachschauen, ob bei dieser Zeile gerade ein neuer Datensatz anfängt
        If ws.Cells(l_Zeile, c_SPDatensatzAnfang).Value =  Then
          
         ->Datensatzanfang suchen
          l_Zeile_DAnf = 0
          For z = l_Zeile - 1 To c_ZMinZeile Step -1
            If ws.Cells(z, c_SPDatensatzAnfang).Value <>  Then l_Zeile_DAnf = z: Exit For
          Next
          
          If l_Zeile_letzterUmbruch < l_Zeile_DAnf Then
            l_Zeile_letzterUmbruch = l_Zeile_DAnf
           ->Seitenumbruch setzen
            ws.HPageBreaks.Add Before:=ws.Range(ws.Cells(l_Zeile_DAnf, 1), ws.Cells(l_Zeile_DAnf, 1))
            
            Application.StatusBar = Bearbeite Seitenumbruch   & x &  von  & ws.HPageBreaks.Count &   Zeile:  & l_Zeile_DAnf
            Exit For-> Seitenumbruch hat sich verändert
          End If
        Else
          l_Zeile_letzterUmbruch = l_Zeile
        End If
      End If

     ->Ende erreicht ?
      If x = ws.HPageBreaks.Count Then MsgBox (Ist vollbracht :-)): GoTo Aufraeumen
    Next
  Loop
Aufraeumen:
  Set ws = Nothing
  ActiveWindow.View = xlNormalView
  Application.StatusBar = s_StatusbarRetten
End Sub
 
Thema:

Seitenumbruch über VBA variable halten

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.840
Beiträge
707.963
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben