Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1700to1704
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schnellbausteine in Word einfügen bei Excel-Aufruf

Schnellbausteine in Word einfügen bei Excel-Aufruf
09.07.2019 17:05:19
Stefan
Hallo,
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schnellbausteine in Word einfügen bei Excel-Aufruf
09.07.2019 17:29:24
Stefan
Gibt es eigentlich eine Möglichkeit, dass ich mein Word-Dokument vorher nicht immer schließen muss (sonst kommt bei mir immer die Meldung, dass es nur schreibgeschützt geöffnet werden kann), sondern dass man direkt das offene Dokument an docWord zuweisen kann?
AW: Schnellbausteine in Word einfügen bei Excel-Aufruf
10.07.2019 09:08:12
Stefan
Ok, das funktioniert schonmal :-), auch wenn ich New Word.Application durch CreateObject("Word.Application") umändern musste. Danke für den Tipp!
Jetzt fehlt mir nur noch die Idee, wie ich die Schnellbausteine einfügen kann...
Normal füge ich es in Word ja über Application.Templates(...) ein. Daher hätte ich gedacht, dass ich es über
With appWord
.Templates(...)
End With
einfügen kann. Leider klappt das so nicht
Anzeige
AW: Schnellbausteine in Word einfügen bei Excel-Aufruf
10.07.2019 09:44:42
Martin
Hallo Stefan,
mit CreateObject("Word.Application") stellst du per Late Binding eine Verbindung zu Word her. In dem Link wird mit Early Binding gearbeitet, dazu muss im VBE-Editor im Menü unter "Extras" und "Verweise..." ein Haken bei "Microsoft Word XX.0 Object Library" (wobei XX eine zweistellige Zahl ist) gesetzt werden.
Hast du mal beim Einfügen des Templates statt "appWord" direkt das Dokument "docWord" eingesetzt? Das Template soll ja ins das Worddokument eingesetzt werden (...ist nur ein Gedanke von mir).
Viele Grüße
Martin
AW: Schnellbausteine in Word einfügen bei Excel-Aufruf
10.07.2019 10:07:30
Stefan
Habe es jetzt mit Where:=docWord.Bookmarks(textmarke) und Where:=docWord.Range probiert. Kenne mich leider mit dem Ansprechen der Orte in WOrd noch nicht wirklich aus. Leider funktioniert beides nicht. Wenn ich es oft genug mit verschiedenen Werte probiere, kommt manchmal zufällig das Einfügen zustande, aberdann ist der rest des Dokumentes verschwunden :-(.
VG Stefan
Anzeige
AW: Schnellbausteine in Word einfügen bei Excel-Aufruf
10.07.2019 10:15:44
Martin
Hallo Stefan,
tut mir leid, dass ich dir da nicht helfen kann. Dafür habe ich deine For ... Each -Schleife deutlich gekürzt:
    For Each cell In Selection
ueberschrift_length = Len(Cells(cell.Row, cell.Column - 1).Value)
text_ueberschrift = cell.Value
With appWord.Selection
Select Case ueberschrift_length
Case 1, 3, 7, 9
.Style = docWord.Styles("Überschrift " & WorksheetFunction.RoundUp(CInt( _
ueberschrift_length), 0))
.TypeText Text:=text_ueberschrift
.TypeParagraph
'.TypeParagraph
Case 5
.Style = docWord.Styles("Überschrift 3")
.TypeText Text:=text_ueberschrift
.TypeParagraph
.Parent.Templates("C:\Users\username\AppData\Roaming\Microsoft\Document Building  _
Blocks\1031\16\Building Blocks.dotx").BuildingBlockEntries("AccordingToDrw").Insert Where:=.Selection.Range, RichText:=True
.TypeParagraph
End Select
End With
i = i + 1
Next
Da ich das alles nicht testen konnte, hoffe ich, dass es auf Anhieb funktioniert :-)
Viele Grüße
Martin
Anzeige
Dazu muss das Template...
10.07.2019 12:02:35
Case
Hallo, :-)
... natürlich auch geladen sein, sonst kannst du nichts abgreifen. ;-)
Option Explicit
Public Sub Main()
Dim objWDApp As Object
Dim objWDDoc As Object
Set objWDApp = OffApp("Word")
If Not objWDApp Is Nothing Then
With objWDApp
Set objWDDoc = .Documents.Add
.Templates.LoadBuildingBlocks
.Templates(2).BuildingBlockEntries("Test").Insert _
Where:=.Selection.Range, RichText:=True
End With
End If
Fin:
Set objWDDoc = Nothing
Set objWDApp = Nothing
If Err.Number  0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
objApp.Visible = True
If Err.Number > 0 Then
MsgBox Err.Number & " " & Err.Description
Set objApp = Nothing
End If
Case 0
Case Else
MsgBox Err.Number & " " & Err.Description
Set objApp = Nothing
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function
Das ist jetzt mal die prinzipielle Vorgehensweise. Worauf musst du bei meinem Beispiel achten?
Das Template "Building Blocks.dotx" muss geladen sein (macht die Codezeile ".Templates.LoadBuildingBlocks")
Bei mir hat das in der Auflistung die Indexnummer 2
Und es gibt bei mir einen Eintrag "Test"
Den letzten Punkt musst du bei dir anpassen. Den Vorletzten eventuell. Kannst du aber im Lokal-Fenster gut kontrollieren.
Servus
Case

Anzeige
AW: Dazu muss das Template...
10.07.2019 15:23:28
Stefan
Das war der entscheidende Tipp :-). Wenn ich die Buildingsblocks erst lade, dann funktioniert alles, wie es soll.
Vielen Dank für eure Hilfe! :-)

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige