AW: textformatierung in word durch Excel vba
14.08.2014 12:26:04
fcs
Hallo Knoof,
hier ein Code-Beispiel, wie man so etwas lösen könnte. Die konkrete Lösung muss dann natürlich an die vorliegenden Daten angepasst werden.
Das Word-Musterdokument hat entsprechende Textmarken, wobei die Absatz mit den Textmarken für die einleitenden Zeile und die Absätze mit den Textmarken für die Auflistungen unterschiedlich formatiert sind.
Ale weitere Unterstützung ist dann nur noch mit Beispieldateien möglich.
Gruß
Franz
Sub Worddateiausfuellen()
'Excel-Objekte
Dim wkb As Workbook
Dim wks As Worksheet
'Word-Objekte
Dim wdApp As Object 'Word.Application
Dim wdDoc As Object 'Word.Document
'allgemeine Variablen
Dim Zeile As Long
Dim strText As String, strText1 As String, strText2 As String
Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets("Tabelle1")
Set wdApp = VBA.CreateObject("Word.Application")
wdApp.Visible = True
'Musterdokument mit den Textmarken schreibgeschützt öffnen
Set wdDoc = wdApp.Documents.Open(Filename:="D:\Test\Test.doc", ReadOnly:=True)
With wks
For Zeile = 2 To 10
If .Cells(Zeile, 3) = "x" Then
'nach Word zu übertragender Text
strText = .Cells(Zeile, 2).Text
'Text an der 1. Zeilenschaltung teilen
strText1 = fncTeilen(strText, bolTeil1:=True) 'Zeilen-text
strText2 = fncTeilen(strText, bolTeil1:=False) 'Listentext
'Texte gemäß Bedingungen an Textmarken einfügen
Select Case Zeile
Case 3 To 5 '1. Textblock
wdDoc.Bookmarks("Textmarke01_Z").Range.Text = strText1
wdDoc.Bookmarks("Textmarke01_Liste").Range.Text = strText2
Case 7 To 8 '2. Textblock
wdDoc.Bookmarks("Textmarke02_Z").Range.Text = strText1
wdDoc.Bookmarks("Textmarke02_Liste").Range.Text = strText2
End Select
End If
Next
End With
wdApp.Activate
End Sub
Function fncTeilen(strText As String, bolTeil1 As Boolean, _
Optional strSep As String = vbLf)
'Text aufteilen am Trennzeichen/Trenntext
'strText = aufzuteilender text
'bolTeil1 = True -- Text links vom Trennzeichen wird zurückgegeben _
False -- Text rechts vom Trennzeichen wird zurückgegeben
'strSep = Trennzeichen/Trenntext zwischen den Textteilen - Vorgabe = Zeilenschaltung
If strText = "" Then
fncTeilen = ""
Else
If InStr(1, strText, strSep) > 0 Then
If bolTeil1 = True Then
fncTeilen = Left(strText, InStr(1, strText, strSep) - 1)
Else
fncTeilen = Mid(strText, InStr(1, strText, strSep) + Len(strSep))
End If
Else
If bolTeil1 = True Then
fncTeilen = strText
Else
fncTeilen = ""
End If
End If
End If
End Function