Private
Sub
word_vorhaben_Click()
Dim
rngCol
As
Range
Dim
rngRow
As
Range
Dim
objWord
As
Object
Dim
objDoc
As
Object
Dim
strText
As
String
Dim
dateiname
As
String
Set
objWord = CreateObject(
"Word.Application"
)
objWord.Visible =
True
Set
objDoc = objWord.Documents.Add
eingabe = InputBox(
"Erwünschte Vorhabensnummer eingeben."
,
"Vorhabensnummer"
)
zeichen = Len(eingabe)
summe = 0
With
ThisWorkbook.Sheets(1)
For
Each
rngCol
In
.Range(.Cells(4, 1), .Cells(.Rows.Count, 1).
End
(xlUp))
If
Left(rngCol.Text, zeichen) = eingabe
Then
For
Each
rngRow
In
.Range(rngCol, .Cells(rngCol.Row, .Columns.Count).
End
(xlToLeft))
If
rngRow <>
""
Then
_
strText = strText & IIf(strText =
""
,
""
,
", "
) & rngRow
Next
rngRow
objWord.Selection.TypeText Text:=strText
objWord.Selection.TypeParagraph
strText =
""
End
If
Next
rngCol
End
With
dateiname = InputBox(
"Dateiname eingeben."
,
"Doc-Datei"
)
objDoc.SaveAs Filename:=ThisWorkbook.Path &
"\" & dateiname & "
.docx", FileFormat:=12
objDoc.Close
False
objWord.Quit
End
Sub