Excel-Word Makro inkl. Formatierung --> Rahmen

Sub Send2Word()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim wdRange As Word.range
Dim Savename As String
Dim Zeile As Long
Dim sText As String
Set wApp = New Word.Application
With wApp
.Visible = True
.Activate
.Documents.Add „link des Dokuments“
'Dateiname Vorlage
Savename = Environ("UserProfile") & "\Desktop\NAME DES DOKUMENTS " & Format(Now, " _
dd_mm_yyyy hh_mm_ss") & ".docx"
Set wDoc = .ActiveDocument
wDoc.SaveAs2 Savename
'Einfüge-Zeile muss ein leere Absatz sein
'Start für das Einfügen ist per Textmarke definiert
'Set wdRange = wDoc.Bookmarks("Excel_Einfuegen").Range 'Start ist per Textmarke _
definiert
'Start für das Einfügen ist am Ende des Documents
Set wdRange = wDoc.range(wDoc.StoryRanges(wdMainTextStory).End - 1, _
wDoc.StoryRanges(wdMainTextStory).End - 1)
For Zeile = 64 To 438
If Rows(Zeile).Hidden = False Then
sText = Cells(Zeile, 2).Text
With wdRange
'Zelltext + Absatzschaltung einfügen
.Text = sText & Chr(13)
Select Case Zeile
Case 1,2,3 'Zeilen mit Überschriften
With .ParagraphFormat
.SpaceBefore = 6
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 22
.Alignment = wdAlignParagraphJustify
End With
.Font.Bold = True
.Font.Size = 22
.Font.ColorIndex = wdDarkBlue
Case 4,5,6'Unterüberschriften
With .ParagraphFormat
.SpaceBefore = 3
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 16
.Alignment = wdAlignParagraphJustify
End With
.Font.Bold = True
.Font.Size = 12
Case Else 'andere Zeilen
With .ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
.LineSpacingRule = wdLineSpaceAtLeast
.LineSpacing = 16
.Alignment = wdAlignParagraphJustify
End With
End Select
End With
Set wdRange = wDoc.range(wdRange.End, wdRange.End)
End If
Next
End With
Set wApp = Nothing
End Sub