Office: Via VBA die erste & letzte Zeile einer Seite ermitteln

User · 22. Januar 2007

Hallo Ingolf,

ähm.. nein, die Überschriften werden durch die Schleife oben generiert!

Code:

Do
If rng.EntireRow.PageBreak xlPageBreakNone Then
zeile = rng.Row
Rows(rng.Row - 1 & ":" & rng.Row - 1).Insert Shift:=xlDown
Rows(rng.Row - 1 & ":" & rng.Row - 1).Insert Shift:=xlDown
Range("B" & rng.Row - 3).FormulaR1C1 = "Suma y sigue"
Range("C" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("D" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("E" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("F" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("G" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("H" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("I" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("A" & rng.Row - 2).FormulaR1C1 = "Cuenta"
Range("B" & rng.Row - 2).FormulaR1C1 = "Descripcíon"
Range("C" & rng.Row - 2).FormulaR1C1 = "Sal. Inicial"
Range("D" & rng.Row - 2).FormulaR1C1 = "Imp. Debe"
Range("E" & rng.Row - 2).FormulaR1C1 = "Imp. Haber"
Range("F" & rng.Row - 2).FormulaR1C1 = "Saldo"
Range("G" & rng.Row - 2).FormulaR1C1 = "Imp. Debe"
Range("H" & rng.Row - 2).FormulaR1C1 = "Imp. Haber"
Range("I" & rng.Row - 2).FormulaR1C1 = "Sal. Acum."
End If
If rng.Row = Range("A65536").End(xlUp).Row Then Exit Do
Set rng = rng.Offset(1, 0)
Loop
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Geht also so leider nicht...

Grüße poijoi

IngGi · 23. Januar 2007

Hallo poijoi,

jetzt komme ich erst mit. Mit Überschriften meinst du die Zeile über den Summen. Ich dachte da kommen noch extra Überschriften an den Anfang jeder Seite. Dann müsste es aber funktionieren. Hast du es schon mit den neuen Codezeilen mit Bezug auf Spalte B probiert? Bei mir funktioniert das so, wie ich es dir im letzten Beitrag beschrieben habe, d.h. er nimmt immer beide Zeilen (Überschriften und Werte) und zusätzlich die letzte Datenzeile mit auf die nächste Seite.

Ansonsten: Was funktioniert denn bei dir nicht, bzw. was macht er bei dir?

Gruß Ingolf

User · 23. Januar 2007

Hallo Ingolf,

ich hab dir mal meinen (fast) kompletten code gepostet:

Code:

Sub Abfrage_Q1()

Dim X1 As String
Dim X2 As String
Dim X3 As String
Dim X4 As String

Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rng As Range
Dim dt1 As Integer
Dim i As Integer

msgbox1 = InputBox("Ingresar año por favor:", "año", Format(CDate(Now), "yyyy"))
If Not IsNull(msgbox1) Then
If IsNumeric(msgbox1) Then
dt1 = (msgbox1)
Else: Exit Sub
End If
Else: Exit Sub
End If

X1 = "select * from bla"
X2 = "select * from blubb"
X3 = "select * from test123"
X4 = "select * from test456"

i = 1

Do While i 1 Then
Sheets.Add.Move After:=Sheets("Q" & i - 1)
Else
Sheets.Add.Move After:=Sheets("Abfrage")
End If

ActiveSheet.Name = "Q" & i

cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=testdb;Data Source=sqlserver"
cnn.Open
cnn.CommandTimeout = "600"
If i = 1 Then
rst.Open X1, cnn
End If
If i = 2 Then
rst.Open X2, cnn
End If
If i = 3 Then
rst.Open X3, cnn
End If
If i = 4 Then
rst.Open X4, cnn
End If

ActiveSheet.QueryTables.Add(Connection:=rst, Destination:=Range("A1")).Refresh

cnn.Close

With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.787401575)
.RightMargin = Application.InchesToPoints(0.787401575)
.TopMargin = Application.InchesToPoints(0.984251969)
.BottomMargin = Application.InchesToPoints(0.984251969)
.HeaderMargin = Application.InchesToPoints(0.4921259845)
.FooterMargin = Application.InchesToPoints(0.4921259845)
.Zoom = 55
End With

ActiveWindow.View = xlPageBreakPreview

Dim zeile As Long
zeile = 1
Set rng = Range("A1")

Do
If rng.EntireRow.PageBreak xlPageBreakNone Then
zeile = rng.Row
Rows(rng.Row - 1 & ":" & rng.Row - 1).Insert Shift:=xlDown
Rows(rng.Row - 1 & ":" & rng.Row - 1).Insert Shift:=xlDown
Range("B" & rng.Row - 3).FormulaR1C1 = "Suma y sigue"
Range("C" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("D" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("E" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("F" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("G" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("H" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("I" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 101) & "C:R[-1]C)"
Range("A" & rng.Row - 2).FormulaR1C1 = "Cuenta"
Range("B" & rng.Row - 2).FormulaR1C1 = "Descripcíon"
Range("C" & rng.Row - 2).FormulaR1C1 = "Sal. Inicial"
Range("D" & rng.Row - 2).FormulaR1C1 = "Imp. Debe"
Range("E" & rng.Row - 2).FormulaR1C1 = "Imp. Haber"
Range("F" & rng.Row - 2).FormulaR1C1 = "Saldo"
Range("G" & rng.Row - 2).FormulaR1C1 = "Imp. Debe"
Range("H" & rng.Row - 2).FormulaR1C1 = "Imp. Haber"
Range("I" & rng.Row - 2).FormulaR1C1 = "Sal. Acum."
End If
If rng.Row = Range("A65536").End(xlUp).Row Then Exit Do
Set rng = rng.Offset(1, 0)
Loop

Range("B" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "Suma y sigue"
Range("C" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("D" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("E" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("F" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("G" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("H" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"
Range("I" & Range("A65536").End(xlUp).Row + 1).FormulaR1C1 = "=SUM(R" & zeile + 1 & "C:R[-1]C)"

If Range("B65536").End(xlUp).EntireRow.PageBreak xlPageBreakNone Then _
Range("B65536").End(xlUp).Offset(-2, 0).EntireRow.PageBreak = xlPageBreakManual

Columns("C:I").Select
Selection.NumberFormat = "#,##0.00"
Cells.EntireColumn.AutoFit
Range("A1").Select

i = i + 1

Loop
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit: If Range("B65536").End(xlUp).EntireRow.PageBreak xlPageBreakNone Then _
Range("B65536").End(xlUp).Offset(-2, 0).EntireRow.PageBreak = xlPageBreakManual provoiziert er einfach einen Zeilenumbruch, es kommt dann aber in der dann vorletzten Zeile am Ende keine Summe und am Anfang der darauf folgenden Seite keine Überschriften (Cuenta, Description, ...).

Die Summe, die auf die letzte Seite forciert wurde, stimmt dann auch nicht mehr!

Grüße
poijoi

IngGi · 23. Januar 2007

Hallo poijoi,

ich hab dich nicht vergessen. Den Fehler, der noch ausgebügelt werden muss, habe ich erkannt. Morgen hau ich mich nochmal rein. Für heute musste ich dein Problem erst mal auf die Seite legen und mich mit etwas anderem beschäftigen, da mir heute mittag der Kopf geraucht hat.

Gruß Ingolf

IngGi · 24. Januar 2007

Hallo poijoi,

uff, das war eine Zangengeburt. Hier nun ein neuer Versuch:
Code:

Sub test()

Dim zeile As Long
Dim rng As Range
Dim ende As Boolean

zeile = 1
Set rng = Range("A1")
Do
If rng.EntireRow.PageBreak <> xlPageBreakNone Or ende Then
Range(rng.Offset(-2, 0), rng.Offset(-1, 0)).EntireRow.Insert Shift:=xlDown
Range("B" & rng.Row - 3).FormulaR1C1 = "Suma y sigue"
Range("D" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("E" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("F" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("G" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("H" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("I" & rng.Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("A" & rng.Row - 4).FormulaR1C1 = "Cuenta"
Range("B" & rng.Row - 4).FormulaR1C1 = "Descripc\'edon"
Range("C" & rng.Row - 4).FormulaR1C1 = "Sal. Inicial"
Range("D" & rng.Row - 4).FormulaR1C1 = "Imp. Debe"
Range("E" & rng.Row - 4).FormulaR1C1 = "Imp. Haber"
Range("F" & rng.Row - 4).FormulaR1C1 = "Saldo"
Range("G" & rng.Row - 4).FormulaR1C1 = "Imp. Debe"
Range("H" & rng.Row - 4).FormulaR1C1 = "Imp. Haber"
Range("I" & rng.Row - 4).FormulaR1C1 = "Sal. Acum."
If Not ende Then zeile = rng.Row
End If
If ende Then Exit Do
If rng.Row = Range("A65536").End(xlUp).Row Then
ende = True
Set rng = rng.Offset(2, 0)
End If
Set rng = rng.Offset(1, 0)
Loop

With Range("B65536").End(xlUp)
If .EntireRow.PageBreak <> xlPageBreakNone Or _
.Offset(-1, 0).EntireRow.PageBreak <> xlPageBreakNone Then

If .EntireRow.PageBreak <> xlPageBreakNone Then
Range(.Offset(-2, 0), .Offset(-1, 0)).EntireRow.Insert
Range("B" & .Row - 3).FormulaR1C1 = "Suma y sigue"
Range("D" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("E" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("F" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("G" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("H" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("I" & .Row - 3).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("A" & .Row - 4).FormulaR1C1 = "Cuenta"
Range("B" & .Row - 4).FormulaR1C1 = "Descripc\'edon"
Range("C" & .Row - 4).FormulaR1C1 = "Sal. Inicial"
Range("D" & .Row - 4).FormulaR1C1 = "Imp. Debe"
Range("E" & .Row - 4).FormulaR1C1 = "Imp. Haber"
Range("F" & .Row - 4).FormulaR1C1 = "Saldo"
Range("G" & .Row - 4).FormulaR1C1 = "Imp. Debe"
Range("H" & .Row - 4).FormulaR1C1 = "Imp. Haber"
Range("I" & .Row - 4).FormulaR1C1 = "Sal. Acum."

For Each rng In Range("D" & .Row & ":I" & .Row)
rng.FormulaR1C1 = "=R[-2]C"
Next 'rng
Else
Range(.Offset(-3, 0), .Offset(-2, 0)).EntireRow.Insert
Range("B" & .Row - 4).FormulaR1C1 = "Suma y sigue"
Range("D" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("E" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("F" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("G" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("H" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("I" & .Row - 4).FormulaR1C1 = "=SUM(R" & Abs(zeile - 2) & "C:R[-2]C)"
Range("A" & .Row - 5).FormulaR1C1 = "Cuenta"
Range("B" & .Row - 5).FormulaR1C1 = "Descripc\'edon"
Range("C" & .Row - 5).FormulaR1C1 = "Sal. Inicial"
Range("D" & .Row - 5).FormulaR1C1 = "Imp. Debe"
Range("E" & .Row - 5).FormulaR1C1 = "Imp. Haber"
Range("F" & .Row - 5).FormulaR1C1 = "Saldo"
Range("G" & .Row - 5).FormulaR1C1 = "Imp. Debe"
Range("H" & .Row - 5).FormulaR1C1 = "Imp. Haber"
Range("I" & .Row - 5).FormulaR1C1 = "Sal. Acum."

For Each rng In Range("D" & .Row & ":I" & .Row)
rng.FormulaR1C1 = "=SUM(R[-3]C:R[-2]C)"
Next 'rng
End If
End If
End With

End Sub
Code eingefügt mit
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

User · 30. Januar 2007

Hallo Ingolf,

hat nicht so recht funktioniert, hab aber mittlerweile nen Workaround gebastelt..

Danke & Grüße
poijoi

Office: Via VBA die erste & letzte Zeile einer Seite ermitteln

Via VBA die erste & letzte Zeile einer Seite ermitteln

Via VBA die erste & letzte Zeile einer Seite ermitteln

Via VBA die erste & letzte Zeile einer Seite ermitteln

Via VBA die erste & letzte Zeile einer Seite ermitteln - Similar Threads - Via VBA letzte

Semikolon via VBA in einzelne Zellen separieren

[VBA] Excel Tabelle via Bookmark nach Word + Größe an Fenster anpassen

STRG+F via Button mit VBA

Versenden E-Mail aus Excel Liste via VBA & Outlook

komplexe Ordnerstrukturen via Excel VBA anlegen

Tabelle in VBA via SQL String erstellen

Daten in Archiv übertragen via VBA