AW: Excel nach Word Zeilenweise
27.10.2012 11:37:27
fcs
Hallo Benny,
der "Trick" besteht darin, dass man nach den Daten eines Excel-Tabellenblatt in Word jeweils 2 fortlaufende Abschnittswechsel einfügt. Der 1. hat die gleichen Einstellungen für die 3 Spalten wie der vorherige Abschnitt. Der 2. kann im Prinzip beliebig sein. Ich hab ihn in meinem Beispiel auf 1 Spaltig gesetzt und lasse in die Zeile jeweils den Namen des Tabellenblatts eingetragen.
Gruß
Franz
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