Excel nach Word - Probleme mit Format in Word
a_ke
ich benötige Hilfe zu folgendem Sachverhalt:
Von Excel wird der Inhalt eines Bereichs zeilenweise nach Word in Textformularfelder übertragen.
Dabei sollen diese in Word in folgender Gliederung erscheinen. Die jeweiligen Punkte und der zugehörige
Text müssen in einer Zeile stehen. (Unterstriche sind in Word Leerzeichen bzw. Tab-Abstand)
Punkt1_____Text zu Punkt1
Punkt2_____Text zu Punkt2
___________weiterer Text zu Punkt2
Punkt3_____Text zu Punkt3
Bei längeren Texten tritt das Probem auf, das der Text dann am Zeilenanfang weitergeschrieben wird
und nicht wie gewünscht. Das sieht dann so aus.
Punkt1_____Text zu Punkt1
Punkt2_____Text zu Punkt2
weiterer Text zu Punkt2
Punkt3_____Text zu Punkt3
In einer zweiten Variante des Makros habe ich es mit zwei Textformularfeldern in einer Word-Tabelle
probiert. Dabei müsste dann jede Zeile aus Excel in eine neue Zeile der Tabelle geschrieben werden
werden. Für die weitere Bearbeitung würde ich diese Variante favorisieren, wenn sie denn funktioniert.
Zur Veranschaulichung habe ich beide Musterdateien als zip-File mit hochgeladen.
https://www.herber.de/bbs/user/80489.zip
Code derzeit:
Sub NachWord()
Dim appWord As Object
Dim docTest As Object
Dim str As String
Dim rng As Range
Set appWord = CreateObject("Word.Application")
Set docTest = appWord.Documents.Add(Worksheets("Tabelle1").Range("B1").Value)
appWord.Visible = True
docTest.Activate
'Variante 1
For Each rng In Worksheets("Tabelle1").Range("B10:B15")
If LCase(rng) = "x" Then
str = str & rng.Offset(0, 1) & Chr(9) & rng.Offset(0, 2) & Chr(11)
End If
Next rng
docTest.Bookmarks("vonExcel").Range.Text = str
'Variante 2 mit Tabelle in Word
Dim str1 As String
Dim str2 As String
For Each rng In Worksheets("Tabelle1").Range("B10:B15")
If LCase(rng) = "x" Then
str1 = str1 & Chr(10) & rng.Offset(0, 1)
str2 = str2 & Chr(10) & rng.Offset(0, 2)
End If
Next rng
docTest.Bookmarks("vonExcel1").Range.Text = str1
docTest.Bookmarks("vonExcel2").Range.Text = str2
Set docTest = Nothing
Set appWord = Nothing
End Sub