Excel-Export, Seitenumbrüche zählen

[Demian]

Moin,moin,

ich möchte bei einem Excelexport die Seitenumbrüche zählen, um die einzelnen Zellen abwechselnd färben zu können.

Ich verwende folgenden Code in einem Agenten:

sub Export()
Dim AktuelleSeite As Integer,Reihe As Long

'Seitenzähler setzen
AktuelleSeite = 1   

'Exportbeginn (Reihe 1 = Überschrift)   
Reihe = 2   
   
'Zeilenweise exportieren   
Do While Not (doc Is Nothing)

   ex.cells(Reihe,1).value = doc.Tarifverband(0)
   ex.cells(Reihe,2).value = doc.Einsatzort(0)
      
   ex.cells(Reihe,3).value = doc.Ausloesung(0)
   ex.cells(Reihe,3).NumberFormat = "0.00 €" 'EURO Formatierung
      
   ex.cells(Reihe,4).value = doc.FGErwachsene(0)
   ex.cells(Reihe,4).NumberFormat = "0.00 €" 'EURO Formatierung
      
   ex.cells(Reihe,5).value = doc.FGAzubis(0)
   ex.cells(Reihe,5).NumberFormat = "0.00 €" 'EURO Formatierung
      
   ex.cells(Reihe,6).value = doc.Niederlassung(0)
      
   ex.cells(Reihe,7).value = SeitenNummer(Reihe,7) ' Spalte wird später gelöscht
      

   If Seitennummer(Reihe,1) > AktuelleSeite Then
      i = i - 1 '1. Zelle auf neuer Seite ist weiß, wegen Wiederholungszeile
      AktuelleSeite = AktuelleSeite + 1
   End If
      
   'ab 2. Zelle jede weitere 2. Zelle grau färben
   i = i + 1      
      
   If i Mod 2 = 0 Then    ex.Range(ex.cells(Reihe,1),ex.cells(Reihe,7)).Interior.ColorIndex = 15
      
   'Userinfo
   Print doc.Einsatzort(0)
      
   Set doc =view.GetNextDocument(doc)
      
   Reihe = Reihe + 1
   Loop
End sub


Für jedes Dokument wird die Seitennummer ermittelt. Hier der Code für die Funktion Seitennummer:


Function Seitennummer(Reihe As Long,Spalte As Integer) As Integer
   Dim wks As Variant                  
   Dim ZaehlerVSU  As Integer
   Dim ZaehlerHSU  As Integer
   
   ' Datei und Blatt der aktuellen Zelle ermitteln
   Set wks = ex.Workbooks(ex.cells(Reihe,Spalte).Parent.Parent.Name).Worksheets(ex.cells(Reihe,Spalte).Parent.Name)
   
   
   ' Reihenfolge der Nummerierung ermitteln
   If wks.PageSetup.Order = 1 Then                     '1 = xlDownThenOver
      ZaehlerHSU = wks.HPageBreaks.Count + 1
      ZaehlerVSU = 1
   Else
      ZaehlerVSU = wks.VPageBreaks.Count + 1
      ZaehlerHSU = 1
   End If
   
   ' Vertikalen Seitenumbruch des Bezugs ermitteln
   Forall VSeitenUmbruch In wks.VPageBreaks
      If VSeitenumbruch.Location.Column > Spalte Then Exit Forall
      SeitenNummer = SeitenNummer + ZaehlerHSU
   End Forall
   
   
   ' Horizontalen Seitenumbruch des Bezugs ermitteln
   Forall HSeitenUmbruch In wks.HPageBreaks
      If HSeitenumbruch.Location.Row > Reihe  Then Exit Forall ' > ex.cells(Reihe,1).Row
      SeitenNummer = SeitenNummer + ZaehlerVSU
   End Forall
   
   ' Rückgabewert an Funktion übergeben
   SeitenNummer = SeitenNummer + 1
End Function


Das Problem liegt in der Zeile : Forall HSeitenumbruch in wks.hpagebreaks
in der Funktion Seitennummer.

Mal läuft der Agent ganz durch und mal bringt er den Fehler "not a collection object". Mal tritt der Fehler in der 1. Zeile auf der 2. Seite auf, mal in der 1. Zeile auf der 3. Seite.

Es hat den Anschein, als würde der Agent sich selbst überholen...

Hat jemand ne Idee woran es liegen könnte, das er die Zeile mal durchläuft und mal nicht?

Gruß
Demian

[HarryB]

Das sieht mir auf jeden Fall nach einem Problem in VBA aus. Mal schein HPageBreaks definiert und mal nicht. Wie sieht denn die Excel Datei genau aus, wenn der Fehler auftritt und wie sieht sie aus, wenn der Fehler nicht auftritt?

Viele Grüße
Harry

[Demian]

Moin Harry,

wenn sie ganz normal durchläuft, sind es in etwa 237 Zeilen, die auch richtig gefärbt werden. Wenn der Fehler dann auftritt hat z. B. die letzte Zeile auf der 2. DIN A4 Zeite (127. Zeile glaube ich) nicht ganz vollständig gemacht. Der Eintrag der Seitennummer in Spalte G (ex.cells(Reihe,7).value = SeitenNummer(Reihe,7) ' Spalte wird später gelöscht) fehlt dann.

Aber wenn .hPagebreaks mal definiert wäre und mal nicht, müsste er ja bei der letzten Zeile auf der 1. Seite schon abbrechen, oder nicht?

Hier trotzdem mal der Original-Code den ich entsprechend angepasst habe.

'--------------------------------------------------'
'   Das Excel-VBA-Codebook, 2. Auflage,            '
'   ISBN: 3-8273-2101-8, Alle Rechte vorbehalten   '
'   Melanie Breden und Monika Weber                '
'--------------------------------------------------'

Option Explicit

Public Function PageNumber(Optional rngCell As Range) As Integer
   Dim wks     As Worksheet
   Dim VPB     As VPageBreak
   Dim HPB     As HPageBreak
   Dim intVPB  As Integer
   Dim intHPB  As Integer
     
   ' Bei fehlendem Bezug nehme die aufrufende Zelle als Bezug
   If rngCell Is Nothing Then Set rngCell = Application.Caller

   ' Datei und Blatt des Bezugs ermitteln
   Set wks = Workbooks(rngCell.Parent.Parent.Name). _
                Worksheets(rngCell.Parent.Name)
   
   ' Reihenfolge der Nummerierung ermitteln
   If wks.PageSetup.Order = xlDownThenOver Then
      intHPB = wks.HPageBreaks.Count + 1
      intVPB = 1
   Else
      intVPB = wks.VPageBreaks.Count + 1
      intHPB = 1
   End If
   
   ' Vertikalen Seitenumbruch des Bezugs ermitteln
   For Each VPB In wks.VPageBreaks
      If VPB.Location.Column > rngCell.Column Then Exit For
      PageNumber = PageNumber + intHPB
   Next VPB
   
   ' Horizontalen Seitenumbruch des Bezugs ermitteln
   For Each HPB In wks.HPageBreaks
      If HPB.Location.Row > rngCell.Row Then Exit For
      PageNumber = PageNumber + intVPB
   Next HPB

   ' Rückgabewert an Funktion übergeben
   PageNumber = PageNumber + 1
End Function

Sub GetPageNumber()
   Dim rngCell As Range
   
   Set rngCell = Application.InputBox( _
                     Prompt:="Wählen Sie eine Zelle aus.", _
                     Title:="Seite ermitteln", _
                     Type:=8)
                 
   MsgBox "Die Zelle " & rngCell.Address(0, 0) & _
          "  befindet sich auf Seite: " & _
          PageNumber(rngCell)
End Sub


Gruß
Demian

[HarryB]

Hi Demian,

Hier trotzdem mal der Original-Code den ich entsprechend angepasst habe.

Das sieht mir ehrlich gesagt etwas unsauber programmiert aus. Die Variable 'PageNumber' bzw. 'Seitennummer' sollte im laufenden Code nicht auftauchen, sondern ausschließlich in der letzten Zeile um den Rückgabewert zu bestimmen. Im laufenden Code solltest du eine Ersatzvariable benennen, zum Beispiel 'tmpSeitenNummer'.

wenn sie ganz normal durchläuft, sind es in etwa 237 Zeilen, die auch richtig gefärbt werden. Wenn der Fehler dann auftritt hat z. B. die letzte Zeile auf der 2. DIN A4 Zeite (127. Zeile glaube ich) nicht ganz vollständig gemacht. Der Eintrag der Seitennummer in Spalte G (ex.cells(Reihe,7).value = SeitenNummer(Reihe,7) ' Spalte wird später gelöscht) fehlt dann.

Ja, das ist logisch. Die Ermitlung der Seitennummer geht ja schief, also kann das Script die Seitennummer auch nicht mehr nach Excel schieben.

Was passiert denn als letztes vor dem Aufruf der Funktion 'Seitennummer' der dann schief geht?

Aber wenn .hPagebreaks mal definiert wäre und mal nicht, müsste er ja bei der letzten Zeile auf der 1. Seite schon abbrechen, oder nicht?

Wann genau wird denn die Funktion 'Seitennummer' aufgerufen? Bei jeder Zeile oder nur bei jeder n-ten?

Viele Grüße
Harry

[Demian]

Moin,moin,

ja das mit der Seitennummer hat mich auch etwas irritert. Habe es aber einfach so hingenommen :)Also, die Funktion wird pro Excel-Zeile 2x aufgerufen. Einmal für den Eintrag in Spalte G und einmal zum Runtersetzen des Zählers i und Hochsetzen des Zählers AktuelleSeite wegen der Zeilenfärbung.

Naja, als letztes ausgeführt wird ex.cells(Reihe,6).value = doc.Niederlassung(0)
Der Eintrag ist dann auch in der Exceltabelle enthalten.

Finde es halt echt seltsam, dass der Fehler nicht immer und nicht immer an der selben Stelle auftritt, obwohl im Code nichts geändert wird.

Vorher hatte ich sämtliche Einträge mittels .select und activecell.value gemacht und habe dann gestern auf cells(Reihe,1).value umgestellt, weil das theoretisch etwas schneller ist, da ja nicht jede Zeile selektiert wird.

Hätt ichs lieber gelassen 

Gruß
Demian

[HarryB]

Naja, als letztes ausgeführt wird ex.cells(Reihe,6).value = doc.Niederlassung(0)
Der Eintrag ist dann auch in der Exceltabelle enthalten.

Kann es sein, dass das Feld Niederlassung einen Wert enthält, der in Excel unzulässig ist? Was passiert zum Beispiel wenn Niederlassung leer ist oder einen Zeilenumbruch enthält?

Finde es halt echt seltsam, dass der Fehler nicht immer und nicht immer an der selben Stelle auftritt, obwohl im Code nichts geändert wird.

Ja, die Fehler sind am schlimmsten einzugrenzen. Meiner Meinung nach ist der Fehler entweder in den Daten zu suchen oder aber in Excel.

Vorher hatte ich sämtliche Einträge mittels .select und activecell.value gemacht und habe dann gestern auf cells(Reihe,1).value umgestellt, weil das theoretisch etwas schneller ist, da ja nicht jede Zeile selektiert wird.

Das sollte eigentlich keinen Unterschied ausmachen, da du letztendlich auf dasselbe Objekt zugreifst, egal ob über activecell oder über cells(x,y).

Viele Grüße
Harry

[Demian]

Moin Harry,

das Feld Niederlassung ist immer gefüllt. Es handelt sich um ein Dialoglistenfeld, Zeilenumbrüche sind nicht möglich. Allerdings ist das Feld Tarifverband nicht immer gefüllt. In Excel bleibt die Zelle dann entsprechend leer.

Vielleicht wird bei cells(x,y) der Seitenumbruch nicht richtig ausgelöst?

Ich werde es einfach mal auf .select zurückstellen und dann mehrmals testen. Ist dann zwar gut ne halbe minute langsamer, aber egal.

Und am Wochenende werde ich den Code mal von Excel nach Excel testen mit cells(x,y). Dann kann ich wenigstens eingrenzen, ob es an Excel liegt oder nicht.

Ich melde mich dann, wenn ich näheres weiß.

Gruß
Demian

[HarryB]

Hallo Demian,

Vielleicht wird bei cells(x,y) der Seitenumbruch nicht richtig ausgelöst?

ich denke nicht, dass es an cells(x,y) liegt. Vielleicht sollte man sich allgemein überlegen, wann der Seitenumbruch berechnet wird.

Wenn ich in Excel eine neues Arbeitsblatt anlege, sehe ich erst mal keine Seitenumbrüche (in diesem Status dürften sie undefiniert sein). Wenn ich mit die Druckvorschau anzeigen lasse, werden danach Seitenumbrüche angezeigt. Möglicherweise werden die Seitenumbrüche beim Ablauf des Scripts auch nicht immer sofort festgelegt bzw. die Berechnung der Seitenumbrüche im Hintergrund dauert länger, als das Script für den nächsten Schritt braucht, was dann eben manchmal zu dem Fehler führt.

Kann man das Berechnen der Seitenumbrüche erwzingen?
Vielleicht könntest du alternativ immer nur eine bestimmte Zahl an Zellen schreiben und dann einen manuellen Umbruch einfügen. Dann ist die Platzausbeute vielleicht nicht optimal, aber das Script rennt wenigstens immer.

Viele Grüße
Harry

[Demian]

Moin,moin,

habe das Ganze jetzt wieder umgestellt.

Function Export
   Dim AktuelleSeite As Integer,Reihe As Long
   'Seitenzähler setzen
   AktuelleSeite = 1   
   Reihe = 2 'Exportbeginn (Reihe 1 = Überschrift)
   
   ex.range("a2").select
   'Zeilenweise exportieren   
   Do While Not (doc Is Nothing)
      
      ex.activecell.value = doc.Tarifverband(0)
      ex.activecell.offset(0,1).value = doc.Einsatzort(0)
      
      ex.activecell.offset(0,2).value = doc.Ausloesung(0)
      ex.activecell.offset(0,2).NumberFormat = "#.##0,00 €" 'EURO Formatierung
      
      ex.activecell.offset(0,3).value = doc.FGErwachsene(0)
      ex.activecell.offset(0,3).NumberFormat = "#.##0,00 €" 'EURO Formatierung
      
      ex.activecell.offset(0,4).value = doc.FGAzubis(0)
      ex.activecell.offset(0,4).NumberFormat = "#.##0,00 €" 'EURO Formatierung
      
      ex.activecell.offset(0,5).value = doc.Niederlassung(0)
      
      ex.activecell.offset(0,6).value = SeitenNummer(ex.activecell) ' Spalte wird später gelöscht
      
      If Seitennummer(ex.activecell) > AktuelleSeite Then
         i = i - 1 '1. Zelle auf neuer Seite ist weiß
         AktuelleSeite = AktuelleSeite + 1
      End If
      
      'ab 2. Zelle jede weitere 2. Zelle grau färben
      i = i + 1      
      
      If i Mod 2 = 0 Then    ex.Range(ex.cells(Reihe,1),ex.cells(Reihe,7)).Interior.ColorIndex = 15
      
      'Userinfo
      Print doc.Einsatzort(0)
      
      Set doc =view.GetNextDocument(doc)
      
      Reihe = Reihe + 1
      
      ex.activecell.offset(1,0).select
   Loop
...


Function Seitennummer(Zelle) As Integer 'Reihe As Long,Spalte As Integer
   Dim wks As Variant                  
   Dim ZaehlerVSU  As Integer
   Dim ZaehlerHSU  As Integer
   
   ' Datei und Blatt der aktuellen Zelle ermitteln
   Set wks = ex.Workbooks(Zelle.Parent.Parent.Name).Worksheets(Zelle.Parent.Name)
   
   ' Reihenfolge der Nummerierung ermitteln
   If wks.PageSetup.Order = 1 Then                     '1 = xlDownThenOver
      ZaehlerHSU = wks.HPageBreaks.Count + 1
      ZaehlerVSU = 1
   Else
      ZaehlerVSU = wks.VPageBreaks.Count + 1
      ZaehlerHSU = 1
   End If
   
   ' Vertikalen Seitenumbruch des Bezugs ermitteln
   Forall VSeitenUmbruch In wks.VPageBreaks
      If VSeitenumbruch.Location.Column > Zelle.Column Then Exit Forall
      SeitenNummer = SeitenNummer + ZaehlerHSU
   End Forall
   
   
   ' Horizontalen Seitenumbruch des Bezugs ermitteln
   Forall HSeitenUmbruch In wks.HPageBreaks
      If HSeitenumbruch.Location.Row > Zelle.row Then Exit Forall ' > ex.cells(Reihe,1).Row
      SeitenNummer = SeitenNummer + ZaehlerVSU
   End Forall
   
   ' Rückgabewert an Funktion übergeben
   SeitenNummer = SeitenNummer + 1
End Function


Das ganze funktioniert jetzt wieder ausnahmslos ohne Fehler.

Hatte aber die Funktion Seitennummer mal direkt in Excel getestet. Sie wirft den nächsten Seitenumbruch erst dann aus, wenn in der letzten Zeile der vorherigen Seite etwas eingegeben wird. Das ist ja aber auch mit cell(x,y) eigentlich der Fall.

Anscheinend wird das ex.activecell.offset(1,0).select anders verarbeitet als cells(x,y).value. Werde mich da aber nochmal im Office-Forum genauer informieren. Wenn ich Rückmeldungen habe, werde ich den Link bereitstellen.

Musste jetzt nur leider feststellen, dass das Einrichten von Rahmen nach dem Export auch zu einer Verschiebung der Seitenumbrüche führt, was dann wiederum eine falsche Zeilenfärbung zur Folge hat.  Mal sehen, werde die Rahmen einfach vorher schon anhand festlegen. Die Anzahl der Zeilen krieg ich ja mit view.allentries.count.

Gruß
Demian