Sub
DokumentEinlesenUndInNeuemDokumentAusgeben()
Dim
strLine
As
String
Dim
colString
As
Collection
Dim
intLastLine
As
Integer
Dim
intLastPage
As
Integer
Dim
flag
As
Boolean
Dim
i
As
Long
Dim
Ansicht
As
Long
Selection.EndKey unit:=wdStory
intLastLine = _
Selection.Range.Information(wdFirstCharacterLineNumber)
intLastPage = _
Selection.Range.Information(wdActiveEndPageNumber)
Set
colString =
New
Collection
Selection.HomeKey unit:=wdStory
flag =
True
While
flag =
True
If
(Selection.Range.Information(wdFirstCharacterLineNumber) = intLastLine)
And
intLastPage = _
Selection.Range.Information(wdActiveEndPageNumber)
Then
flag =
False
End
If
Selection.EndKey unit:=wdLine, Extend:=wdExtend
strLine = Selection.Range.Text
colString.Add (strLine)
Selection.MoveDown unit:=wdLine, Count:=1
Selection.HomeKey unit:=wdLine
Wend
Dim
aDok
As
Document
Dim
nDok
As
Document
Set
aDok = ActiveDocument
Set
nDok = Documents.Add _
(Template:=aDok.AttachedTemplate.FullName)
nDok.Range(0, 0).
Select
For
i = 1
To
colString.Count - 1
Selection.TypeText Text:=colString.Item(i)
Selection.MoveDown unit:=wdLine, Count:=1
Next
i
End
Sub