Sub Tabellendaten_3_Spaltig_in_Word()
' Daten der Tabellenblätter in einem Worddokument in 3 Spalten eintragen
Dim xlWkb As Excel.Workbook, xlWks As Excel.Worksheet
Dim xlZeile As Long
Dim wdApp As Object
Set xlWkb = ActiveWorkbook
'Neue Word-Instanz starten
Set wdApp = VBA.CreateObject(Class:="Word.Application")
With wdApp
.Visible = True
.ScreenUpdating = False
.Activate
'ggf. Ansichtsfenster geeignet einstellen
.Documents.Add 'leeres Dokument anlegen
If .ActiveWindow.ActivePane.View.Type 3 Then
.ActiveWindow.ActivePane.View.Type = 3 'wdPrintView
End If
If .ActiveWindow.View.SplitSpecial 0 Then '0 = wdPaneNone
.ActiveWindow.Panes(2).Close
End If
'Seitenränder des Dokuments einstellen
With .ActiveDocument
With .PageSetup
.LeftMargin = Application.CentimetersToPoints(2)
.RightMargin = Application.CentimetersToPoints(1)
.TopMargin = Application.CentimetersToPoints(1.5)
.BottomMargin = Application.CentimetersToPoints(1.5)
End With
End With
'Tabstop setzen in aktiver Zeile und für alle weiteren Zeilen die eingefügt werden
.Selection.Paragraphs(1).TabStops.ClearAll
.Selection.Paragraphs(1).TabStops.Add Position:=.CentimetersToPoints(2.5), _
Alignment:=0 'wdAlignTabLeft
For Each xlWks In xlWkb.Worksheets
Select Case LCase(xlWks.Name)
Case "tabelle1", "tab X100"
'aus diesen Tabellen keine Daten nach Word schreiben
Case Else
'Tabellenname einfügen in Word
.Selection.TypeText Text:=xlWks.Name 'Titel Tabelle
.Selection.TypeParagraph
'Einfügen Abschnittswechsel - fortlaufend - 3 Spalten - mit Trennlinie - Abstand 0,75 _
cm
.Selection.InsertBreak Type:=3 'wdSectionBreakContinuous
With .Selection.PageSetup.TextColumns
.SetCount NumColumns:=3
.EvenlySpaced = True
.LineBetween = True
' .Width = CentimetersToPoints(5.17)
.Spacing = Application.CentimetersToPoints(0.75)
End With
'Exceldaten aus Tabellenblatt Spalten C und D einfügen
For xlZeile = 1 To xlWks.Cells(xlWks.Rows.Count, 3).End(xlUp).Row
.Selection.TypeText Text:=xlWks.Cells(xlZeile, 3).Text & vbTab _
& xlWks.Cells(xlZeile, 4).Text
.Selection.TypeParagraph
Next
'Einfügen Abschnittswechsel - fortlaufend ohne Änderung der Einstellungen
.Selection.InsertBreak Type:=3 'wdSectionBreakContinuous
'Einfügen Abschnittswechsel - fortlaufend - 1 Spalten - ohne Trennlinie
.Selection.InsertBreak Type:=3 'wdSectionBreakContinuous
With .Selection.PageSetup.TextColumns
.SetCount NumColumns:=1
.EvenlySpaced = True
.LineBetween = False
End With
End Select
Next xlWks
'Tabstop löschen in aktiver Zeile
.Selection.Paragraphs(1).TabStops.ClearAll
.ScreenUpdating = True
End With
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen