AW: Werte aus Excel-Tabelle an Word DocProperty übergeben
19.12.2019 08:55:18
fischer
Hallo snb, ich kenne mich nicht aus :> Warum wäre das besser? Wegen der Verarbeitungsgeschwindigkeit, Stabilität?
jetzt habe ich das makro mit meinen Begriffen und werten gefüllt (die auch in der word-datei angelegt sind). aber nichts passiert....
Option Explicit
Sub cmdInTextfeldschreiben()
Dim wdApp As Object
Dim wdDoc As Object
Dim wdRng As Object
Dim wdCustProp As Object
Dim wdDatei As String
Dim wb As Excel.Workbook
'Dim ws As Excel.Worksheet
'Arbeitsmappe mit diesem Makro
Set wb = ThisWorkbook
'Set ws = wb.Worksheets("Sheet1")
'Word als Object starten
Set wdApp = CreateObject("Word.Application") 'Word als Object starten
'Worddatei festlegen - befindet sich im gleichen Verzeichnis wie diese Excel-AM
wdDatei = wb.Path & "\Worddatei.docx"
Set wdDoc = wdApp.documents.Open(wdDatei)
wdApp.Visible = True
With wdDoc
On Error Resume Next
Set wdCustProp = .CustomDocumentProperties("a")
If Not (wdCustProp Is Nothing) Then
.CustomDocumentProperties("a").Value = [a].Value
Else
MsgBox "Die Word-Property 'a' existiert nicht!", 64, "zur Information"
End If
Set wdCustProp = .CustomDocumentProperties("b")
If Not (wdCustProp Is Nothing) Then
.CustomDocumentProperties("b").Value = [b].Value
Else
MsgBox "Die benutzerdefinierte Word-Property 'b' existiert nicht!", 64, "zur _
Information"
End If
Set wdCustProp = .CustomDocumentProperties("c")
If Not (wdCustProp Is Nothing) Then
.CustomDocumentProperties("c").Value = [c].Value
Else
MsgBox "Die benutzerdefinierte Word-Property 'c' existiert nicht!", 64, "zur _
Information"
End If
Set wdCustProp = .CustomDocumentProperties("d")
If Not (wdCustProp Is Nothing) Then
.CustomDocumentProperties("d").Value = [d].Value
Else
MsgBox "Die benutzerdefinierte Word-Property 'd' existiert nicht!", 64, "zur _
Information"
End If
'On Error GoTo 0
.CustomDocumentProperties.Update
.Save
'alle Felder aktualisieren
For Each wdRng In .StoryRanges
wdRng.Fields.Update
While Not (wdRng.NextStoryRange Is Nothing)
Set wdRng = wdRng.NextStoryRange
wdRng.Fields.Update
Wend
Next wdRng
MsgBox .CustomDocumentProperties("a").Value
MsgBox .CustomDocumentProperties("c").Value
MsgBox .CustomDocumentProperties("b").Value
MsgBox .CustomDocumentProperties("d").Value
End With
Set wdRng = Nothing
Set wdDoc = Nothing
Set wdCustProp = Nothing
Set wdApp = Nothing
'Set ws = Nothing
Set wb = Nothing
MsgBox "F e r t i g", 48
End Sub