Excel geschlossene Textmarke ansprechen
03.09.2020 12:53:28
David
ich hänge wieder einmal an der Schnittstelle Excel-Word. Ich öffne mit einem Excel Code eine Word-Datei und bepacke diese an offene Textmarken mit Text. Das klappt auch prima. In der Word-Datei möchte ich später an einigen Textstellen Querverweise auf die Textmarken setzen, so dass sowohl der Textinhalt als auch der Link zur Textmarke an der ausgewählten Stelle eingefügt wird. Word übernimmt allerdings leider nur den Textinhalt, wenn es sich um eine geschlossene Textmarke handelt. Sobald ich die Textmarken "Anhang" in meiner Word-Vorlage allerdings als geschlossene Textmarken definiere und die geschlossene Textmarke aus Excel-VBA ansprechen will, verschwindet die Textmarke in dem Word-Dokument an der entsprechenden Stelle und lässt sich somit nicht mehr verlinken.
Ist es überhaupt möglich geschlossene Textmarken aus Excel heraus anzusprechen?
Ich hoffe ich konnte mein Problem verständlich rüberbringen. Anbei der Code:
Option Explicit
Public objWordRange As Object
Public objDocument As Object
Public objDialog As Object
Public objApp As Object
Public strVorlage As String
Public c As Boolean
Sub ExportExceltoWord ()
strVorlage = "Pfad zur Datei"
Set objApp = OffApp("Word")
If Not objApp Is Nothing Then
Set objDocument = objApp.Documents.Add(Template:=strVorlage)
With objApp
Do While c = False
If MsgBox("Anhang mit einfügen?", vbYesNo) = vbYes Then
objDocument.Bookmarks("Anhang").Range.Select '----> "Anhang" ist die Textmarke um die es _
sich handelt
objApp.Selection.InlineShapes.AddPicture Filename:=Application.GetOpenFilename
Else
c = True
End If
Loop
MsgBox ("Anhang wurde eingefügt")
c = False
objDocument.Bookmarks("Anhang").Range.Select '----> hier wird wieder auf die Textmarke _
verwiesen
objApp.Selection.Text = "Anhang"
objApp.Selection.Style = objDocument.Styles("Überschrift 1")
End With
Application.CutCopyMode = True
' Objektvariable objWordRange leeren
Set objWordRange = Nothing
Set objDialog = objApp.Dialogs(wdDialogFileSaveAs)
With objDialog
' Pfad vorgeben
.Name = "Speicherpfad"
' Wenn auf Speichern geklickt wurde...
If .Display = -1 Then
objDocument.SaveAs Filename:=.Name
End If
' Dokument schliessen
objDocument.Close
End With
Else
' Ausgabe, wenn die Objektvariable objApp Nothing ist...
MsgBox "Applikation nicht installiert!"
End If
Fin:
If Not objApp Is Nothing Then
' Word war nicht offen, also...
If blnTMP = True Then
' ... Word schliessen
objApp.Quit
blnTMP = False
End If
End If
' Objektvariablen leeren
Set objWordRange = Nothing
Set objDocument = Nothing
Set objApp = Nothing
Application.CutCopyMode = True
' Wenn die Fehlernummer NICHT 0 ist, dann gib die Fehlernummer
' und die Fehlerbeschreibung aus
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Danke und Gruß
