Einzelne Word-Seiten lesen und neu speichern

Einzelne Word-Seiten lesen und neu speichern. wdBrowsePage, ComputeStatistics(wdStatisticPages)
Dieses Beispiel speichert jede einzelne Seite des aktiven
WORD-Dokumentes in ein neues WORD-Dokument ab
Public Sub JedeSeiteInNeuesDokument()
Dim wdDoc As Document Aktives Dokument
Dim wdDocNeu As Document Neues Dokument
Dim wdBereich As Range Dokument-Bereich
Dim sPfad As String Pfadangabe für neue Dokumente
Dim optAnsicht As Long Dokumentansicht
Dim iSeitenAnz As Integer Anzahl der Seiten im Dokument
Dim i As Integer Zähler
Dim iDocNum As Integer Zähler für Dateiname
'Verweis auf Dokument setzen:
Set wdDoc = ActiveDocument
'Speicher-Pfad für neue Dokumente:
'Es wird vorausgesetzt, dass das aktive Dokument gespeichert ist
sPfad = wdDoc.Path & "\" & "Test_"
'Bildschirmaktualisierung deaktivieren (Flackern wird zumindest vermindert)
Application.ScreenUpdating = False
'Einstellung Seiten-Ansicht sichern:
'optAnsicht = wdDoc.ActiveWindow.View.Type
optAnsicht = Windows(wdDoc).View.Type
'Seiten-Ansicht SeitenLayout einstellen:
Windows(wdDoc).View.Type = wdPageView
'Cursor zum Anfang des Dokuments:
wdDoc.Range(0, 0).Select
'Browser-Eigenschaft einstellen, hier: "Nach Seite durchsuchen"
'Gibt ein Browser-Objekt zurück, das die Schaltfläche "Objekt für
'Durchsuchen markieren" auf der vertikalen Bildlaufleiste darstellt
Application.Browser.Target = wdBrowsePage
'Dokument-Nr. zum Speichern - Startwert setzen
iDocNum = 0
'Anzahl Seiten im Dokument ermitteln
iSeitenAnz = wdDoc.ComputeStatistics(wdStatisticPages)
For i = 1 To iSeitenAnz
'Verweis auf den zu kopierenden Bereich setzen
Set wdBereich = wdDoc.Bookmarks("\Page").Range
'Den zu kopierenden Bereich überprüfen, ob Seitenwechsel dabei ist;
'ggf. den Bereich verkleinern
If Right(wdBereich.Text, 1) = Chr(12) Then
wdBereich.SetRange Start:=wdBereich.Start, End:=wdBereich.End - 1
End If
'Neues Dokument öffnen, auf Basis derselben Dokumentvorlage
'wie das Original-Dokument
Set wdDocNeu = Documents.Add _
(Template:=wdDoc.AttachedTemplate.FullName)
'oder auf Basis der Normal.dot:
'Set wdDocNeu = Documents.Add
'Formatierten Text -> neue Datei
wdDocNeu.Content.FormattedText = wdBereich.FormattedText
'Dokument-Nr. zum Speichern erhöhen
iDocNum = iDocNum + 1
'Neues Dokument speichern:
wdDocNeu.SaveAs FileName:=sPfad & Format(iDocNum, "000")
'Neues Dokument schließen
wdDocNeu.Close
'Dokument aktivieren
wdDoc.Activate
'Zur nächsten Seite im Original-Dokument wechseln
Application.Browser.Next
Next i
'Ursprüngliche Seiten-Ansicht wieder einstellen
Windows(wdDoc).View.Type = optAnsicht
'Cursor zum Anfang des Dokuments
wdDoc.Range(0, 0).Select
'Bildschirmaktualisierung aktivieren
Application.ScreenUpdating = True
'Verweise freigeben
Set wdBereich = Nothing
Set wdDocNeu = Nothing
Set wdDoc = Nothing
End Sub

Mehr Tipps: Word - Automatische Nummerierung entfernt die ersten Zahlen

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt