Text nach Bookmark einfügen
15.01.2021 23:22:02
Firefly1111
ich bin neu im Forum. Dank dieses Forums konnte ich bereits vielle VBA Probleme selber lösen, aber jetzt finde ich keine passende Lösung weder im deutschen noch im englischen Sprachraum.
Ich habe eine Excel Datei bestehend aus verschiedenen Tabellen. Jede Tabelle entspricht einem Kapitel in Word. Die Inhalte der Exceldatei werden dynamisch erzeugt. Das heißt die Anzahl der Tabellen, die nach Word exportiert werden variieren. Als auch die Inhalte innerhalb einer Tabelle. Die einzelnen Tabellen entsprechen der Reihenfolge der Kapitel. Sprich Tabelle 1 ist Kapitel 1, Tabelle 2 ist Kapitel 2 etc..
In meinem Wordtemplate ist nur eine Textmarke Ueberschriften hinterlegt. Dies ist mein Startpunkt. Meine Idee. Nach jedem Einfügen erzeuge ich ein neues Bookmark entsprechend des Tabellenblattnames.
Bisher funktioniert, das erfolgreiche übertragen in Word. Das Einfügen der Texte und das generieren der Bookmarks.
Mein Problem
Die Texte aus Excel werden nicht nach jedem Bookmark eingefügt, sondern immer Davor. Sprich die Kapitel starten in umgekehrter Reihenfolge. Ich denke es müsste mit InsertAfter funktionieren, aber dann überträgt das Makro keinen Text. Zusätzlich ist der erste Kapitel ordenlich formatiert entsprechend der Spalten. Daher specialpaste. Die anderen Kaptiel sind leider alle in Spalte 1.
Optimal wäre noch ein Enter nach jedem Kapitel.
Ich würde mich über eine Codeanpassung freuen. Vielen Dank im Voraus.
Sub ExcelDatenNachWord()
Dim AppWord As Object
Dim dateiname As String
Dim TextMarke As Word.Bookmark
Dim Bereich As Range
Dim WS_Count As Integer
Dim I, letztezeile As Integer
Dim Blattname As String
Dim BlattnameNext As String
'Fehlerbehandlung aktivieren
On Error Resume Next
'Word öffnen
Set AppWord = CreateObject("Word.application")
WS_Count = ActiveWorkbook.Worksheets.Count
dateiname = "c:\dok1.docx" 'ANPASSEN
With AppWord
.Documents.Add dateiname
.Visible = True: .WindowState = xlMaximized
End With
'Textelemente einlesen. Die Kapitel starten ab Tabelle 4
For I = 4 To WS_Count
Blattname = Worksheets(I).Name
BlattnameNext = Worksheets(I + 1).Name
'Hier wird die letzte Zeile in der Tabelle ermittelt.
letztezeile = Sheets(Blattname).UsedRange.SpecialCells(xlCellTypeLastCell).Row
'Einfügen von Texten in Word aus Excel an entsprechender Bookmark und dann zm nächsten _
_
_
_
setzen
With AppWord.ActiveDocument
Set Bereich = Worksheets(Blattname).Range("A1:G" & letztezeile + 1) 'Bereich mit _
den zu exportierenden Daten
Bereich.Copy
If I = 4 Then
Set TextMarke = .Bookmarks("Ueberschriften")
Else
Set TextMarke = .Bookmarks(Blattname)
End If
'Text einfügen als RTF
TextMarke.Range.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False
.Bookmarks.Add Name:=BlattnameNext, Range:=TextMarke.Range
End With
Next I
MsgBox "Daten sind übertragen"
End Sub