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