Herbers Excel-Forum - das Archiv

letzte zeile im druckbereich

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: letzte zeile im druckbereich
von: der reik

Geschrieben am: 14.03.2005 22:11:15
moin moin
ich habe folgendes problem:
ich brauche für ein projekt die letzte zeile im druckbereich (den excel von sich aus wählt) weil ich dort die gesamtsumme der darüberliegenden zellen zusammenzählen möchte. die inhalte und formeln werden über ein makro eingetragen. die letzte zeile kann sich aber durch einen zeilenumbruch jederzeit ändern weil ich in einer spalte auch text zu stehen habe und der platz manchmal nicht reicht. ich betone ausdrücklich das ich nicht die letzte zeile brauche in der etwas steht sondern die letzte zeile auf der seite.
danke für eure hilfe
Bild

Betrifft: AW: letzte zeile im druckbereich
von: Ramses

Geschrieben am: 14.03.2005 22:27:36
Hallo
Sieht zwar kompliziert aus, aber bei VBA-Gut kannst du das sicher anpassen
Sub Test_HBreak_und_Teilsummen_setzen()
'Variablen deklarieren
Dim n As Long
Dim myVB As Integer
Dim QE1 As Integer, QE2 As Integer, QE3 As String, QE4 As String
Dim RTsum As Long, CTsum As Integer, CTLeft As Integer, myPSum As Long
Dim InterSum As Double
Dim wks As String
'Variablen setzen
'Diese Variablen bitte an deine Bedürfnisse anpassen
RTsum = 0 'Nicht verändern
'Hier die Variablen anpassen
wks = "Tabelle1" 'Tabelle in der die Daten stehen
'Spaltennummern definieren
'1 = A, 2 = B, 3 = C usw
CTsum = 8 'Spaltennummer in der die Teilsumme erstellt werden soll !!! Hier "I" !!!!
CTLeft = 1 'Spaltennummer der Spalte die summiert werden soll !!! Hier "H"
'Kontrolle
'Ausstieg definieren wenn nicht die richtige Tabelle gedruckt wird
If ActiveSheet.name <> wks Then
GoTo EndCheck
End If
'Ausstieg wenn nur eine Seite gedruckt werden kann
If ExecuteExcel4Macro("Get.Document(50)") = 1 Then
MsgBox ("Es kann nur eine Seite gedruckt werden" & Chr$(13) & "das Makro wird abgebrochen !")
GoTo EndCheck
End If
'Fragen ob die Teilsummen erstellt werden sollen
QE1 = MsgBox("Sollen Teilsummen eingesetzt werden ?", vbCritical + vbYesNo, "Teilsummen setzen")
If QE1 = 7 Then
GoTo EndCheck
End If
'Wohin soll die Zwischensumme
QE2 = MsgBox("Teilsummen in die Fusszeile einfügen ?", vbCritical + vbYesNo, "Teilsumme in Fusszeile oder Zelle")
If QE2 = 7 Then
QE3 = InputBox("In welcher Spalte sollen die Zwischensummen stehen", "Summe", Right(Left(Cells(1, CTsum).Address, 2), 1))
If IsNumeric(QE3) Then
MsgBox ("Es sind nur Buchstaben als Spaltenbezeichnungen erlaubt." & Chr$(13) & "Makro wird abgebrochen")
Exit Sub
End If
'Neue Zielspalte für Zwischensummen zufügen
CTsum = Range(QE3 & "1").Column
End If
'Summe aus welcher Spalte
QE4 = InputBox("Welche Spalte soll summiert werden?", "Summe", Right(Left(Cells(1, CTLeft).Address, 2), 1))
If IsNumeric(QE4) Then
MsgBox ("Es sind nur Buchstaben als Spaltenbezeichnungen erlaubt." & Chr$(13) & "Makro wird abgebrochen")
Exit Sub
End If
'Neue Spalte zuweisen
CTLeft = Range(QE4 & "1").Column
If QE2 = 6 Then
GoTo SumFusszeile
End If
'Start
'Teilsummen setzen in Zelle
'ACHTUNG:
' " Worksheets(wks).HPageBreaks.Item(1).Location "
'erwartet mindestens zwei Druckseiten,
'sonst wird ein falsches Ergebnis geliefert.
'Kein Workaround bekannt
SumZelle:
For n = 1 To ExecuteExcel4Macro("Get.Document(50)")
If n = 1 Then
myPSum = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1)") - 1
Cells(myPSum, CTsum).FormulaR1C1 = "=SUM(R[-" & myPSum - 1 & "]C[" & CTLeft - CTsum & "]:RC[" & CTLeft - CTsum & "])"
RTsum = myPSum
Else
Cells(myPSum, CTsum).FormulaR1C1 = "=SUM(R[-" & RTsum - 1 & "]C[" & CTLeft - CTsum & "]:RC[" & CTLeft - CTsum & "])"
End If
myPSum = myPSum + RTsum
Next n
'Nächsten Block überspringen
GoTo EndCheck
SumFusszeile:
'Teilsummen setzen in Fusszeile
On Error Resume Next
For n = 1 To ExecuteExcel4Macro("Get.Document(50)")
If n = 1 Then
myPSum = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1)") - 1
InterSum = Application.WorksheetFunction.Sum(Range(Cells(1, CTLeft), Cells(myPSum - 1, CTLeft)))
RTsum = myPSum - 1
Else
InterSum = Application.WorksheetFunction.Sum(Range(Cells((myPSum - RTsum), CTLeft), Cells(myPSum - 1, CTLeft)))
End If
With ActiveSheet.PageSetup
.LeftFooter = "Seite " & n & " von " & ExecuteExcel4Macro("Get.Document(50)")
.RightFooter = InterSum
End With
'Hier das Hochkomma entfernen zum ausdrucken und vor die nächste
'Zeile das Hochkomma setzen
'ActiveWindow.SelectedSheets.PrintOut from:=n, To:=n, Copies:=1, Collate:=True
ActiveWindow.SelectedSheets.PrintPreview
myPSum = myPSum + RTsum
Next n
EndCheck:
End Sub

Gruss Rainer
Bild

Betrifft: AW: letzte zeile im druckbereich
von: der reik
Geschrieben am: 14.03.2005 22:52:47
das ist ja der hammer, es funzt, aber wieso? ich kann soviele zeilenumbrüche machen wie ich will und es passt immer noch, genial. *D*A*N*K*E* an welcher stelle liest das makro den druckbereich aus?
nochmals dankend der reik
Bild

Betrifft: AW: letzte zeile im druckbereich
von: Ramses

Geschrieben am: 14.03.2005 22:58:30
Hallo
"... es funzt, aber wieso? "
Keine Ahnung,... habe einfach mal drauf los geschrieben :-))
"... an welcher stelle liest das makro den druckbereich aus?..."
Es wird nicht der Druckbereich ausgelesen, sondern die Anzahl Druckseiten "ExecuteExcel4Macro("Get.Document(50)")" und die erste Zeile der nächsten Seite "ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1)")"
Der Rest ist keine Hexerei :-)
Gruss Rainer
Bild

Betrifft: AW: letzte zeile im druckbereich
von: der reik
Geschrieben am: 14.03.2005 23:17:35
ich bin begeistert!
und ganz nebenbei bemerkt, ebenfalls ein dankeschön von meiner freundin, sie dachte schon ich werd nie fertig :)
mfg der reik
Bild

Betrifft: AW: letzte zeile im druckbereich
von: Beate Schmitz

Geschrieben am: 14.03.2005 22:47:13
Hallo Reik,
habe dir hier geantwortet:
http://www.excel-center.de/foren/read.php?2,13792,13846#msg-13846
Info an die anderen möglichen Antworter:
Da er dort aber einen halben Tag vergeblich auf eine Antwort gewartet hat, ist das wohl kein Crossposting.
 Bild
Excel-Beispiele zum Thema "letzte zeile im druckbereich"
Letzte nichtleere Zelle ermitteln Letzter Wert in Zeile
Letztes Speicherdatum eintragen Letzter Wert aus einem Bereich
Letztes Speicherdatum in die Fußzeile aller Tabellenblätter Formel bis zur letzten Zeile der Nebenspalte kopieren
Letzte Zelle mit Inhalt suchen Letzte Zelle einer Spalte mit Inhalt aus geschlossener Arbeitsmappe
Letzte Verknüpfung in einem Tabellenblatt löschen Letztes Zeichen der Werte einer Zellauswahl hoch-/tiefstellen