Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1036to1040
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Seitenwechsel

Seitenwechsel
14.01.2009 10:32:00
Diana
Liebes Forum,
ich erzeuge in einem externen Programm eine Ausgabe in eine Worddatei (ich weiß, das ist ein Excel-Forum, aber vielleicht ist das in VBA gleich). In dieser Datei werden einzelne Tabellen hintereinander herausgeschrieben. Jede Tabelle hat zusätzlich eine Überschrift, welche immer mit AWBZ= beginnt.
Nun mein Problem: Es kommt vor, dass eine Tabelle auf der einen Seite beginnt und dann auf der nächsten Seite fortgesetzt wird. Das möchte ich vermeiden. Jede neue Seite muss oben eine Kennung (Überschrift) der Tabelle haben. Leider kann ich diesen Seitenumbruch nicht in dem externen Programm steuern. Eine Wiederholung der Überschrift wäre zwar möglich, aber es soll grundsätzlich keine Tabelle über zwei Seiten gehen.
Gibt es vielleicht eine Möglichkeit mit VBA diese Seitenwechsel nach dem Erzeugen der Worddatei einzufügen. Es könnte ja folgendermaßen automatisiert werden. Suche nach Seiten, die keine Überschrift (also "AWBZ=" als erste Zeichen) auf der Seiten haben. Dann gehe Zeile für Zeile zurück, bis du auf eine Zeile triffst, die mit "AWBZ=" beginnt. Füge Seitenwechsel ein.
Geht das?
Vielen Dank schon einmal
Gruß
Diana

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Seitenwechsel
14.01.2009 15:51:00
fcs
Hallo Diana,
die beiden folgende Makros haben es bei mir gemacht. Sie arbeiten am in Word aktiven Dokument
Der Unterschied der beiden Variante ist die Art wie geprüft wird, dass der Cursor oberhalb der Tabelle ist, wenn eine Seite eingefügt werden muss. Variante 1 prüft auf den Textanfang. Variante 2 prüft ob der Cursor sich innerhalb der Tabelle befindet; diese Variante benötigt keinen Prüfstring.
Die 2. Variante ist schneller in der Ausführung.
Die Function wird für beide Varianten benötigt. Die Makros funktionieren nicht, wenn eine Tabelle über mehr als eine Seite geht.
Gruß
Franz

Sub Seitenwechsel_1()
' Seitenwechsel Makro - Erstellt mit Word 2003
' Tabellen immer oben auf Seite beginnen mit Überschrift
Dim wdRange As Range, wdDoc As Document
Dim intCount As Integer
Const strSuch As String = "ABWZ=" 'Anfangstext der Überschrift
Set wdDoc = ActiveDocument
If PagesDoc(wdDocument:=wdDoc) = 1 Then Exit Sub
'Cursor auf Dokumentanfang positionieren
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
Do
'zum nächsten Seitenanfang springen
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
'Die 1. Zeichen gemäß Läneg Suchstring markieren
Selection.MoveRight Unit:=wdCharacter, Count:=Len(strSuch), Extend:=wdExtend
Set wdRange = Selection.Range
If wdRange.Text  strSuch Then
Do
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Set wdRange = Selection.Range
If Left(wdRange.Text, 5) = strSuch Then
wdRange.Collapse
wdRange.InsertBreak Type:=wdPageBreak
Exit Do
End If
Loop
End If
Set wdRange = Selection.Range
intCount = intCount + 1 'Sicherheitszähler für Schleife, bei 50 wird abgebrochen _
50 in nächster Anweisung ggf. anpassen, wenn Dokumente mehr Seiten haben können.
'Prüfen, ob letzte Seite im Dokument erreicht
If wdRange.Information(Type:=wdActiveEndPageNumber) = PagesDoc(wdDocument:=wdDoc) _
Or intCount > 50 Then
Exit Do
End If
Loop
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
MsgBox "Fertig, Seitenwechsel überprüft und ggf. eingefügt."
End Sub
Sub Seitenwechsel_2()
' Seitenwechsel Makro - Erstellt mit Word 2003
' Tabellen immer oben auf Seite beginnen mit Überschrift
Dim wdRange As Range, wdDoc As Document, intSeiten As Integer
Dim intCount As Integer
Set wdDoc = ActiveDocument
If PagesDoc(wdDocument:=wdDoc) = 1 Then Exit Sub
'Cursor auf Dokumentanfang positionieren
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
intSeiten = 1
Do
'zum nächsten Seitenanfang springen
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=intSeiten, Name:=""
'Prüfen, ob 1. Zeile in Tabelle.
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = True Then
Do
'Cursor aufwärts bewegen bis er außerhalb der Tabelle ist
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = False Then
'Seitenwechsel einfügen
wdRange.InsertBreak Type:=wdPageBreak
Exit Do
End If
Loop
End If
Set wdRange = Selection.Range
intCount = intCount + 1 'Sicherheitszähler für Schleife, bei 50 wird abgebrochen _
50 in nächster Anweisung ggf. anpassen, wenn Dokumente mehr Seiten haben können.
'Prüfen, ob letzte Seite im Dokument erreicht
If wdRange.Information(Type:=wdActiveEndPageNumber) = PagesDoc(wdDocument:=wdDoc) _
Or intCount > 50 Then
Exit Do
End If
Loop
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
MsgBox "Fertig, Seitenwechsel überprüft und ggf. eingefügt."
End Sub
Function PagesDoc(wdDocument As Document) As Long
'Ermittelt die Gesamtseitenzahl des Dokuments
Dim wdRange As Range
Set wdRange = wdDocument.Content
wdRange.Collapse Direction:=wdCollapseEnd
PagesDoc = wdRange.Information(Type:=wdActiveEndPageNumber)
End Function


Anzeige
AW: Seitenwechsel
15.01.2009 08:54:00
Diana
Hallo Franz,
vielen herzlichen Dank für die Arbeit. Ich habe beide Versionen getestet. Die erste führt zum Absturz von Word. Die zweite lief innerhalb von Sekunden durch. Es wurde auch eine Tabelle, welche über zwei Seiten ging auf die nächste Seite umgebrochen. Allerdings nur eine Tabelle. Auf Seite 34/35 kam das Problem zum ersten mal, und diese wurde umgebrochen. Alle weiteren "getrennten" Tabellen wurden nicht zusammengeführt.
Kannst du mir da noch einmal kurz helfen?
Viele Grüße
Diana
AW: Seitenwechsel
15.01.2009 10:42:00
fcs
Hallo Diana,
ich hatte gestern auf die Schnelle keine Logik gefunden, mit der ich einfach eine Tabelle abarbeiten kann, die über mehrere Seiten geht, und deshalb "nur" die Notbremse eingebaut.
Die Lösung war dann jetzt doch nicht so kompliziert. Hier angepasste Prozedur. Die Function ist jetzt auch nicht mehr nötig, da ich bei der Suche nach einer Lösung herausgefunden hab, wie ich die Anzahl der Seiten im Dokument direkt ermiteln kann.
Gruß
Franz

Sub Seitenwechsel_2()
' Seitenwechsel Makro - Erstellt mit Word 2003 - Modifiziert 2009-01-15
' Tabellen immer oben auf Seite beginnen mit Überschrift-Textzeile
Dim wdRange As Range, wdDoc As Document
Set wdDoc = ActiveDocument
'Prüfen, ob Dokument nur eine Seite hat
If wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) = 1 Then Exit Sub
'Cursor auf Dokumentanfang positionieren
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
Do
'zum nächsten Seitenanfang springen
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
'Prüfen, ob 1. Zeile in Tabelle.
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = True Then
Do
'Cursor aufwärts bewegen bis er außerhalb der Tabelle ist
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = False Then
'Seitenwechsel einfügen
wdRange.InsertBreak Type:=wdPageBreak
'Cursor in 1. Tabellenzeile unterhalb Überschrift positionieren
Do Until wdRange.Information(Type:=wdWithInTable) = True
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
'Cursor hinter Tabelle positionieren
Do Until wdRange.Information(Type:=wdWithInTable) = False
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
Exit Do
End If
Loop
End If
Set wdRange = Selection.Range
'Prüfen, ob letzte Seite im Dokument erreicht
If wdRange.Information(Type:=wdActiveEndPageNumber) = _
wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) Then
Exit Do
End If
Loop
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
MsgBox "Fertig, Seitenwechsel überprüft und ggf. eingefügt."
End Sub


Anzeige
AW: Seitenwechsel
15.01.2009 11:38:50
Diana
Hallo Franz,
vielen Dank für die schnelle Antwort. Es ist wie verhext. Nun funktionieren fast alle Seitenwechsel, nur manchmal nimmt er die Überschrift nicht mit auf die nächste Seite. Die Überschrift ist immer mit einer Zeile Abstand über der Tabelle, aber das hatte ich gestern schon in dem Code geändert (Selection.MoveUp Unit:=wdLine, Count:=2). Ich hoffe das war richtig abgeändert, es klappt jedenfalls für die ersten Tabellen. Dann aber nicht mehr, dann bringt er immer nur die Tabelle auf die nächste Seite, ohne Überschrift. Manchmal ist es auch so, dass es nicht nur eine Zeile Überschrift ist, sondern zwei. Aber immer mit einer Zeile Abstand (Leerzeile) zur Tabelle und immer mit dem Beginn "AWBZ=".
Kannst du bitte noch einmal schauen?
Herzlichen Dank
Diana
Anzeige
AW: Seitenwechsel
15.01.2009 15:38:15
fcs
Hallo Diana,
ich hab die Prüfung auf "ABWZ=" als Beginn einer Seite jetzt in die Schleifen eingebaut.
Hier auch mal meine Testdatei inkl. Makro.
https://www.herber.de/bbs/user/58431.doc
Gruß
Franz

Sub Seitenwechsel_2()
' Seitenwechsel Makro - Erstellt mit Word 2003 - Modifiziert 2009-01-15
' Tabellen immer oben auf Seite beginnen mit Überschrift-Textzeile
Dim wdRange As Range, wdRangeABWZ As Range, wdDoc As Document
Const strSuchwort As String = "ABWZ=" 'Zeichenfolge am Beginn einer Seite
Set wdDoc = ActiveDocument
If wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) = 1 Then Exit Sub
'Cursor auf Dokumentanfang positionieren
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
Do
'zum nächsten Seitenanfang springen
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
'Prüfen auf ABWZ= am Seitenbeginn
Set wdRange = Selection.Range
Set wdRangeABWZ = wdRange
wdRangeABWZ.End = wdRangeABWZ.End + Len(strSuchwort)
If wdRangeABWZ.Text  strSuchwort Then
wdRangeABWZ.Collapse
'Prüfen, ob Zeile in Tabelle.
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = True Then
Do
'Cursor aufwärts bewegen bis er außerhalb der Tabelle ist
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = False Then
Exit Do
End If
Loop
End If
'Prüfen auf ABWZ=
Do
Set wdRangeABWZ = wdRange
wdRangeABWZ.End = wdRangeABWZ.End + Len(strSuchwort)
If wdRangeABWZ.Text = strSuchwort Then Exit Do
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
wdRangeABWZ.Collapse
'Seitenwechsel einfügen
If wdRange.Start > wdDoc.Content.Start Then 'Anfang des documents
wdRange.InsertBreak Type:=wdPageBreak
End If
'Cursor in 1. Tabellenzeile unterhalb Überschrift positionieren
Do Until wdRange.Information(Type:=wdWithInTable) = True
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
'Cursor hinter Tabelle positionieren
Do Until wdRange.Information(Type:=wdWithInTable) = False
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
End If
Set wdRange = Selection.Range
'Prüfen, ob letzte Seite im Dokument erreicht
If wdRange.Information(Type:=wdActiveEndPageNumber) = _
wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) Then
Exit Do
End If
Loop
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = True
MsgBox "Fertig, Seitenwechsel überprüft und ggf. eingefügt."
End Sub


Anzeige
AW: Seitenwechsel
15.01.2009 16:47:07
Diana
Hallo Franz,
herzlichen DANK!!!! Es läuft, du bist ein Genie ... das erleichtert die Arbeit ungemein. Kein fehlerhafter Seitenwechsel mehr und dadurch keine falsch vesandten Unterlagen. Einfach super! Ich kann mich garnicht genug bedanken für die schnelle Lösung. Ich hoffe es musste nichts bei dir liegen bleiben.
Gruß Diana
AW: Seitenwechsel
16.01.2009 17:56:54
Diana
Hallo Franz,
einige Dateien (und das waren nciht wenige) sind schon sehr erfolgreich durchgelaufen.
Nun haben wir eine Datei, in der er einfach hängen bleibt. VBA führt einige Seitenwechsel wohl aus, man sieht es daran, dass eine Neunummerierung der Seiten vorgenommen wird, aber dann brincht er einfach ab und Word macht nichts mehr. Man kann dann nur noch das Programm über Task Manager beenden.
Hast du eine Ahnung woran das liegen kann? Ich habe vermutet, ob das eventuell an einer mehrzeiligen Überschrift liegt. Manchmal geht die Überschrift über zwei Zeilen.
Gruß und schönes Wochenende
Diana
Anzeige
AW: Seitenwechsel
19.01.2009 11:29:21
Schließer
Hallo Diana,
warum das Makro bei der bestimmten Datei Probleme macht kann ich schlecht sagen.
Vom logischen Ablauf her sollte es funktionieren.
Ein Problem könnte sein, dass das Suchwort zwischen 2 Tabellen nicht gefunden wird. Warum auch immer - und das Makro endet in einer Endlosschleife.
Ich hab jetzt noch eine Prüfung eingebaut, die bei der Suche nach dem Suchwort in der Überschrift zusätzlich prüft, ob der Cursor in die Tabelle oberhalb der Überschrift gewandert ist. Ebenso eine Prüfung bzgl. Zeitlimit und max. Seitenzahl bei der Ausführung.
Das Zeitlimit (z.Zt auf 15 Sekunden gesetzt) und die max. Seitenzahl muss du ggf. Anpassen, wenn die Dokumente sehr lang sind.
Dadurch wird das Makro in der Ausführung zwar etwas langsamer, aber anders kann man die Problemstelle kaum ausfindig machen.
Gruß
Franz

Sub Seitenwechsel_2()
' Seitenwechsel Makro - Erstellt mit Word 2003 - 2009-01-16
' - Modifiziert 2009-01-19 - Fehlerüberwachung
' Tabellen immer oben auf Seite beginnen mit Überschrift-Textzeile
Dim wdRange As Range, wdRangeABWZ As Range, wdDoc As Document
Dim StartZeit As Date, Zeitlimit As Date
Dim intFehler As Integer, strFehler As String
Const strSuchwort As String = "ABWZ="
Const intSeitenMax As Integer = 100 ' ggf. Anpassen wenn Dokumente mehr Seiten haben können
Const bolFehler = True 'Bei False ist die Zeitlimit-Überwachung deaktiviert
Zeitlimit = TimeSerial(0, 0, 15) 'max. zulässige Zeit in Schleife = 15 Sekunden
On Error GoTo Fehler
Set wdDoc = ActiveDocument
If wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) = 1 Then Exit Sub
'Cursor auf Dokumentanfang positionieren
Selection.HomeKey Unit:=wdStory
Application.ScreenUpdating = False
StartZeit = Now
Do
'zum nächsten Seitenanfang springen
intFehler = 1
strFehler = "Undefinierter Fehler im Ablauf"
If Now - StartZeit > Zeitlimit And bolFehler Then GoTo Fehler
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:=""
'Prüfen auf ABWZ= am Seitenbeginn
Set wdRange = Selection.Range
'Prüfen auf max. Seitenzahl
If wdRange.Information(Type:=wdActiveEndPageNumber) > intSeitenMax Then
intFehler = 10
strFehler = "Dokument hat max. Seitenzahl von " & intSeitenMax & " erreicht!"
GoTo Fehler
End If
Application.StatusBar = "Seite " & wdRange.Information(Type:=wdActiveEndPageNumber) _
& " von zur Zeit " & wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) _
& " Seiten wird bearbeitet."
Set wdRangeABWZ = wdRange
wdRangeABWZ.End = wdRangeABWZ.End + Len(strSuchwort)
If wdRangeABWZ.Text  strSuchwort Then
wdRangeABWZ.Collapse
'Prüfen, ob Zeile in Tabelle.
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = True Then
intFehler = 2
strFehler = "Fehler bei Suche der Zeile vor Tabelle"
Do
'Cursor aufwärts bewegen bis er außerhalb der Tabelle ist
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
If Now - StartZeit > Zeitlimit And bolFehler Then GoTo Fehler
If wdRange.Information(Type:=wdWithInTable) = False Then
Exit Do
End If
Loop
End If
'Prüfen auf ABWZ=
intFehler = 3
strFehler = "Fehler bei Suche nach Prüfwort: " & strSuchwort
Do
Set wdRangeABWZ = wdRange
If Now - StartZeit > Zeitlimit And bolFehler Then GoTo Fehler
wdRangeABWZ.End = wdRangeABWZ.End + Len(strSuchwort)
If wdRangeABWZ.Text = strSuchwort Then Exit Do
Selection.MoveUp Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
If wdRange.Information(Type:=wdWithInTable) = True Then
'Cursor ist jetzt in Tabelle oberhalb
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
MsgBox "Zwischen zwei Tabellen wurde der Suchstring nicht gefunden" _
& vbLf & "Seitenwechsel wird vor Text eingefügt."
Exit Do
End If
Loop
wdRangeABWZ.Collapse
'Seitenwechsel einfügen
If wdRange.Start > wdDoc.Content.Start Then 'Anfang des documents
wdRange.InsertBreak Type:=wdPageBreak
End If
'Cursor in 1. Tabellenzeile unterhalb Überschrift positionieren
intFehler = 4
strFehler = "Fehler bei Suche nach Tabelle unter Überschrift"
Do Until wdRange.Information(Type:=wdWithInTable) = True
If Now - StartZeit > Zeitlimit And bolFehler Then GoTo Fehler
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
'Cursor hinter Tabelle positionieren
intFehler = 5
strFehler = "Fehler beim Positionieren hinter einer Tabelle"
Do Until wdRange.Information(Type:=wdWithInTable) = False
If Now - StartZeit > Zeitlimit And bolFehler Then GoTo Fehler
Selection.MoveDown Unit:=wdLine, Count:=1
Set wdRange = Selection.Range
Loop
End If
Set wdRange = Selection.Range
'Prüfen, ob letzte Seite im Dokument erreicht
If wdRange.Information(Type:=wdActiveEndPageNumber) = _
wdDoc.Content.Information(Type:=wdNumberOfPagesInDocument) Then
Exit Do
End If
Loop
intFehler = 0
Selection.HomeKey Unit:=wdStory
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Fertig, Seitenwechsel überprüft und ggf. eingefügt."
Fehler:
With Err
If intFehler > 0 Then
If intFehler = 10 Then
MsgBox strFehler, vbOKOnly, "Fehler - max. Seitenzahl"
Else
MsgBox "Zeitlimit-Überschreitung mit Fehler-Zähler-Nr.(intFehler):" _
& intFehler & vbLf & strFehler, vbOKOnly, "Fehler - Zeitüberschreitung"
End If
ElseIf .Number  0 Then
MsgBox "Fehler-Nr." & .Number & vbLf & .Description, _
vbOKOnly, "Fehler - VBA-Ablauf"
End If
End With
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub


Anzeige
Tipp - Makro - Abbrechen
19.01.2009 11:33:00
fcs
Hallo Diana,
kleiner Tipp noch. Fall die Ausführung eines Makros nicht zu Ende kommt (Endlosschleife) dann kann man mit der Tastenkombination Strg+Pause(Unterbr) die Makroausführung abbrechen.
Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige