ich habe mir im Excel eine Gliederung für ein Word-Dokument überlegt und möchte das Dokument nun mit Schnellbausteinen unter den jeweiligen Überschriften aufbauen. Also die einzelnen Zeilen werden ins Word als Überschrift kopiert und die Überschrift wird nach dem Überschriftenformat(1Spalte links von den selektierten Überschriften) formatiert (z.B. "5.x.x" - Länge 5). Leider funktioniert das noch nicht wie gewollt mit den Schnellbausteinen:
Konkret geht es um den Text unter Case 5 (je nach Länge des Gliederungspunktes in Excel wird eine andere Überschrift gewählt). Unter der Überschrift soll nun der Schnellbaustein eingefügt werden (mittels Application.Templates()). Allerdings kommt hier der Fehler 5941: Das angeforderte Element ist nicht in der Sammlung vorhanden. Direkt in Word kann ich allerdings den Schnellbaustein einfügen (Application.Templates()). Ich denke ich habe nur ein Problem mit dem Zugriff, da ich das Makro aus Excel heraus ausführe und in Word den Baustein einfügen möchte.
Würde mich freuen, wenn mir jemand helfen kann.
Sub ueberschriften_excel_word_nach_auswahl()
'Daten müssen so strukturiert sein, dass in der Spalte links von der Auswahl die Ü _
berschriftennummer steht
'es werden alle Überschriften in die Datei geschrieben (Datei muss vorher geschlossen sein und _
_
es muss eine Textmarke "temp" eingesetzt sein)
Dim text_ueberschrift As String
Dim ueberschrift_length As String
Dim appWord As Object
Dim docWord As Object
Dim i As Integer
Dim cell As Range
Dim dateiname As String, textmarke As String
dateiname = "Dateiname.docx"
textmarke = "temp"
Set appWord = CreateObject("Word.Application")
Set docWord = appWord.Documents.Open(dateiname) 'Word-Dokument muss vorher geschlossen _
_
sein
appWord.Visible = True
docWord.Bookmarks(textmarke).Select 'Textmarke wählen, wo Daten eingefügt _
werden sollen
i = 1
For Each cell In Selection
ueberschrift_length = Len(Cells(cell.Row, cell.Column - 1).Value)
text_ueberschrift = cell.Value
With appWord
Select Case ueberschrift_length
Case 1
.Selection.Style = docWord.Styles("Überschrift 1")
.Selection.TypeText text:=text_ueberschrift
.Selection.TypeParagraph
.Selection.TypeParagraph
Case 3
.Selection.Style = docWord.Styles("Überschrift 2")
.Selection.TypeText text:=text_ueberschrift
.Selection.TypeParagraph
.Selection.TypeParagraph
Case 5
.Selection.Style = docWord.Styles("Überschrift 3")
.Selection.TypeText text:=text_ueberschrift
.Selection.TypeParagraph
.Templates( _
"C:\Users\username\AppData\Roaming\Microsoft\Document Building Blocks\1031\16\Building _
_
Blocks.dotx" _
).BuildingBlockEntries("AccordingToDrw").Insert Where:=.Selection.Range, _
RichText:=True
.Selection.TypeParagraph
Case 7
.Selection.Style = docWord.Styles("Überschrift 4")
.Selection.TypeText text:=text_ueberschrift
.Selection.TypeParagraph
.Selection.TypeParagraph
Case 9
.Selection.Style = docWord.Styles("Überschrift 5")
.Selection.TypeText text:=text_ueberschrift
.Selection.TypeParagraph
.Selection.TypeParagraph
Case Else
End Select
End With
i = i + 1
Next
appWord.Activate
Set appWord = Nothing
Set docWord = Nothing
End Sub