Sub ExcelZuWord()
Dim wdApp As Object
Dim wdoc As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0
If wdApp Is Nothing Then
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
End If
wdApp.Documents.Add
Set wdoc = wdApp.ActiveDocument
With wdApp.Selection
.TypeText Text:=Einleitungstext
.TypeParagraph
.TypeParagraph
.TypeText Text:="Text1:"
.TypeParagraph
.TypeText Text:=Text1
.TypeParagraph
.TypeParagraph
.TypeText Text:="Text2:"
.TypeParagraph
.TypeText Text:=Text2
.TypeParagraph
.TypeParagraph
.TypeText Text:="Text3:"
.TypeParagraph
.TypeText Text:=Text3
End With
With wdoc.Range(344, 474).Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ";"
.Replacement.Text = ","
.Forward = True
.Wrap = 0
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
.ClearFormatting
.Replacement.ClearFormatting
.Text = ", "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
End With
wdoc.Range(344, 474).ConvertToTable Separator:=0
With wdoc.Tables(1)
.Style = "Tabellenraster"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.Borders(-1).LineStyle = 0
.Borders(-2).LineStyle = 0
.Borders(-3).LineStyle = 0
.Borders(-4).LineStyle = 0
.Borders(-5).LineStyle = 0
.Borders(-6).LineStyle = 0
.Borders(-7).LineStyle = 0
End With
Set wdoc = Nothing
Set wdApp = Nothing
End Sub