ich möchte einzelne Seiten aus einer langen Word-Datei in ein
neues Dokument kopieren. Habe hierzu schon einen schönen
VBA-Code im Internet gefunden. Leider kann hier nur eine Seite
ausgewählt werden. Kann jemand den Code so anpassen, dass
mehrere Seiten ausgewählt werden können? Im Voraus schon mal
Hi eisbaer-13,
schon mal bei dem Link geschaut der in der Brettbeschreibung von Textverarbeitung steht!?
Ansonsten, habe am Code gebastelt, jetzt kannst du mehrere Seiten auswählen.
Prinzipiell läuft der Code auch, leider kopiert er immer nur Seite 1 der Quelldatei. Irgendwas ist mit:
Set oRange = Documents(Quelle).Bookmarks("\Page").Range
und allen anderen auskommentierten Zeilen faul, ich kriege die aktive Seite nicht markiert/kopiert.
Gruß
Reinhard
Option Explicit
Sub Seiten\_kopieren()
Dim Max As Long, Antwort As String, N As Integer
Dim A, NN, VonBis, DocName
Dim nDoc As Document, oRange As Range, Quelle, Ziel, myRange
Max = ActiveDocument.ComputeStatistics(wdStatisticPages)
Antwort = InputBox(Text(Max), "Seite kopieren", "1-" & Max)
If Antwort = "" Then Exit Sub
For N = 1 To Len(Antwort) 'Ueberpruefung ob nur "0-9" "," "-" in der Eingabe
Select Case Asc(Mid(Antwort, N, 1))
Case 48 To 57, 44, 45
Case Else
MsgBox "Wo steht daß hier das Zeichen " & Chr(39) & Mid(Antwort, N, 1) & Chr(39) & " erlaubt sei?"
Exit Sub
End Select
Next N
A = Split(Antwort, ",")
Quelle = ThisDocument.Name
Set nDoc = Documents.Add
Ziel = ActiveDocument.Name
Documents(Quelle).Activate
For N = 0 To UBound(A)
If InStr(A(N), "-") = 0 Then A(N) = A(N) & "-" & A(N)
VonBis = Split(A(N), "-")
For NN = VonBis(0) To VonBis(1)
MsgBox NN
'Documents(Quelle).GoTo What:=wdGoToBookmark, Name:=CInt(NN)
'Documents(Quelle).GoTo What:=wdGoToPage, Count:=CInt(NN)
Documents(Quelle).GoTo What:=wdGoToPage, Name:=CStr(NN)
'Documents(Quelle).GoTo What:=wdGoToPage, Name:=CInt(NN)
Set oRange = Documents(Quelle).Bookmarks("\Page").Range
MsgBox oRange
'If Right(oRange.Text, 1) = Chr(12) Then 'Seitenumbruch ausschliessen
' oRange.SetRange Start:=oRange.Start, End:=oRange.End - 1
'End If
Set myRange = Documents(Ziel).Content
myRange.InsertAfter oRange.FormattedText & Chr(12)
Next NN
Next N
End Sub
Function Text(ByVal M As String) As String
Text = "Welche Seite(n) soll(en) kopiert werden?" & vbCrLf
Text = Text & "1 - " & M & vbCrLf & vbCrLf
Text = Text & "Sie können nur eine aber auch mehrere Seiten angeben" & vbCrLf
Text = Text & "Trennzeichen sind " & Chr(39) & "," & Chr(39) & " und " & Chr(39) & " - " & Chr(39) & vbCrLf & vbCrLf
Text = Text & "Gültige Engabebeispiele:" & vbCrLf
Text = Text & "3" & vbTab & vbTab & "Seite 3 wird kopiert" & vbCrLf
Text = Text & "3,7,12" & vbTab & vbTab & "Seiten 3 7 12 werden kopiert" & vbCrLf
Text = Text & "3,7-12,15" & vbTab & "Seiten 3 7 8 9 10 11 12 15 werden kopiert" & vbCrLf
End Function
