<p>Einzelne Word-Seiten mittels VBA in ein neues Dokument kopieren</p>
<!-- HTML generated using hilite.me -->
<div style="background: #ffffff; overflow: auto; width: auto; border: solid gray; border-width: .1em .1em .1em .8em; padding: .2em .6em;">
<pre style="margin: 0; line-height: 125%;"><span style="color: #000080; font-weight: bold;">Sub</span> Seiten_kopieren()
<span style="color: #000080; font-weight: bold;">Dim</span> iMaxPage%, sAntwort$, i%, ii%, sTmp$
<span style="color: #000080; font-weight: bold;">Dim</span> arr, arrSeiteVonBis
<span style="color: #000080; font-weight: bold;">Dim</span> nDoc, oRange <span style="font-weight: bold;">As</span> Range, oQuelle, oZiel
<span style="color: #000080; font-weight: bold;">On</span> <span style="color: #000080; font-weight: bold;">Error</span> <span style="color: #000080; font-weight: bold;">GoTo</span> Errors_
<span style="color: #000080; font-weight: bold;">Set</span> oQuelle = ActiveDocument
iMaxPage = oQuelle.ComputeStatistics(wdStatisticPages)
sAntwort = InputBox(InputBoxTxt(iMaxPage), <span style="color: #0000ff;">"Seite kopieren"</span>, <span style="color: #0000ff;">"1-"</span> & iMaxPage)
<span style="color: #000080; font-weight: bold;">If</span> sAntwort = <span style="color: #0000ff;">""</span> <span style="color: #000080; font-weight: bold;">Then</span> <span style="color: #000080; font-weight: bold;">GoTo</span> Exit_
Application.ScreenUpdating = <span style="color: #000080; font-weight: bold;">False</span>
sTmp = <span style="color: #0000ff;">""</span>
<span style="color: #000080; font-weight: bold;">For</span> i = <span style="color: #0000ff;">1</span> <span style="color: #000080; font-weight: bold;">To</span> Len(sAntwort) <span style="color: #008800; font-style: italic;">'Ueberpruefung ob nur "0-9" "," "-" in der Eingabe</span>
<span style="color: #000080; font-weight: bold;">Select</span> <span style="color: #000080; font-weight: bold;">Case</span> Asc(Mid(sAntwort, i, <span style="color: #0000ff;">1</span>))
<span style="color: #000080; font-weight: bold;">Case</span> <span style="color: #0000ff;">48</span> <span style="color: #000080; font-weight: bold;">To</span> <span style="color: #0000ff;">57</span>, <span style="color: #0000ff;">44</span>, <span style="color: #0000ff;">45</span>
<span style="color: #000080; font-weight: bold;">Case</span> <span style="color: #000080; font-weight: bold;">Else</span>
sTmp = sTmp & Mid(sAntwort, i, <span style="color: #0000ff;">1</span>) & <span style="color: #0000ff;">" "</span>
<span style="color: #000080; font-weight: bold;">Exit</span> <span style="color: #000080; font-weight: bold;">Sub</span>
End <span style="color: #000080; font-weight: bold;">Select</span>
<span style="color: #000080; font-weight: bold;">Next</span>
<span style="color: #000080; font-weight: bold;">If</span> sTmp <> <span style="color: #0000ff;">""</span> <span style="color: #000080; font-weight: bold;">Then</span> MsgBox <span style="color: #0000ff;">"Ungültige Eingabe "</span> & Chr(<span style="color: #0000ff;">39</span>) & Mid(sAntwort, i, <span style="color: #0000ff;">1</span>) & Chr(<span style="color: #0000ff;">39</span>)
arr = Split(sAntwort, <span style="color: #0000ff;">","</span>)
<span style="color: #000080; font-weight: bold;">Set</span> oZiel = Documents.Add
<span style="color: #000080; font-weight: bold;">For</span> i = <span style="color: #0000ff;">0</span> <span style="color: #000080; font-weight: bold;">To</span> UBound(arr)
<span style="color: #000080; font-weight: bold;">If</span> InStr(arr(i), <span style="color: #0000ff;">"-"</span>) = <span style="color: #0000ff;">0</span> <span style="color: #000080; font-weight: bold;">Then</span> arr(i) = arr(i) & <span style="color: #0000ff;">"-"</span> & arr(i)
arrSeiteVonBis = Split(arr(i), <span style="color: #0000ff;">"-"</span>)
<span style="color: #000080; font-weight: bold;">For</span> ii = arrSeiteVonBis(<span style="color: #0000ff;">0</span>) <span style="color: #000080; font-weight: bold;">To</span> arrSeiteVonBis(<span style="color: #0000ff;">1</span>)
sTmp = <span style="color: #000080; font-weight: bold;">CStr</span>(ii)
oQuelle.Activate
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=sTmp
<span style="color: #000080; font-weight: bold;">Set</span> oRange = Documents(oQuelle).Bookmarks(<span style="color: #0000ff;">"\Page"</span>).Range
oRange.Select
<span style="color: #008800; font-style: italic;">'If Right(oRange.Text, 1) = Chr(12) Then 'Seitenumbruch ausschliessen</span>
<span style="color: #008800; font-style: italic;">' oRange.SetRange Start:=oRange.Start, End:=oRange.End - 1</span>
<span style="color: #008800; font-style: italic;">'End If</span>
Selection.Copy
oZiel.Activate
Selection.Paste
<span style="color: #000080; font-weight: bold;">Next</span>
<span style="color: #000080; font-weight: bold;">Next</span>
oQuelle.Activate
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=<span style="color: #0000ff;">1</span>
<span style="color: #000080; font-weight: bold;">Set</span> oZiel = <span style="color: #000080; font-weight: bold;">Nothing</span>
<span style="color: #000080; font-weight: bold;">Set</span> oQuelle = <span style="color: #000080; font-weight: bold;">Nothing</span>
Errors_:
Err.Clear
Exit_:
Application.ScreenUpdating = <span style="color: #000080; font-weight: bold;">True</span>
<span style="color: #000080; font-weight: bold;">End</span> <span style="color: #000080; font-weight: bold;">Sub</span>
<span style="color: #000080; font-weight: bold;">Function</span> InputBoxTxt(<span style="color: #000080; font-weight: bold;">ByVal</span> sRange$) <span style="font-weight: bold;">As</span> <span style="color: #000080; font-weight: bold;">String</span>
<span style="color: #000080; font-weight: bold;">Dim</span> sTmp$
sTmp = <span style="color: #0000ff;">"Welche Seite(n) soll(en) kopiert werden?"</span> & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"1 - "</span> & sRange & vbCrLf & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"Sie können nur eine aber auch mehrere Seiten angeben"</span> & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"Trennzeichen sind "</span> & Chr(<span style="color: #0000ff;">39</span>) & <span style="color: #0000ff;">","</span> & Chr(<span style="color: #0000ff;">39</span>) & <span style="color: #0000ff;">" und "</span> & Chr(<span style="color: #0000ff;">39</span>) & <span style="color: #0000ff;">" - "</span> & Chr(<span style="color: #0000ff;">39</span>) & vbCrLf & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"Gültige Engabebeispiele:"</span> & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"3"</span> & vbTab & vbTab & <span style="color: #0000ff;">"Seite 3 wird kopiert"</span> & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"3,7,12"</span> & vbTab & vbTab & <span style="color: #0000ff;">"Seiten 3 7 12 werden kopiert"</span> & vbCrLf
sTmp = sTmp & <span style="color: #0000ff;">"3,7-12,15"</span> & vbTab & <span style="color: #0000ff;">"Seiten 3 7 8 9 10 11 12 15 werden kopiert"</span> & vbCrLf
InputBoxTxt = sTmp
<span style="color: #000080; font-weight: bold;">End</span> <span style="color: #000080; font-weight: bold;">Function</span>
</pre>
</div>