模板中的VBA Word ContentControlOnExit

Question

我刚接触VBA编程，现在遇到了问题。 我从Excel文件中在Word文档中填充了一个下拉组合框。 基于对下拉列表条目的选择，将填充其他文本字段。 如果将代码保存在“ thisDocument”模块中，则一切正常。

现在我希望每个基于normal.dotm创建和创建的文档都可以访问此代码。到目前为止，我只是将代码复制到normal.dotm“ thisDocument”模块中。 “ Document_Open-Sub”（带有Excel条目的填充下拉菜单）中的代码可以正常工作。但是ContentControlOnExit-Part上没有任何反应。

我已阅读到该事件在模板而不是您实际退出ContentControl的文档中触发。有什么方法可以在文档上而不是模板中使用该事件？

TLDR：如何在基于normal.dotm的每个文档中使用我normal.dotm模板中的ContentControlOnExit-Event？

'Globale Variable für Collection in der alle Mitarbeiter Objekte liegen
Dim mitColl As New Collection

Private Sub Document_Open()

'Erstellt aus der Excel Tabelle 
'Mitarbeiter Objekte mit Vor- und Nachnamen, Funktion, Kürzel

'Variablen Deklaration für das Einlesen der Mitarbeiter Liste
Dim pfad As String
Dim datei As String
Dim blatt As String
Dim zelle As String
Dim row As Integer
Dim column As Integer


'Angabe zur Excel Tabelle aus der die Mitarbeiter gelesen werden
pfad = "xxx"
datei = "xxx.xlsx"
blatt = "ExcelBericht"
Set xlApp = CreateObject("excel.application")
xlApp.Workbooks.Open pfad & datei
Set dok = xlApp.ActiveWorkbook.Worksheets("ExcelBericht")

'Anzahl Reihen und Spalten von der Excel Tabelle
row = dok.UsedRange.Rows.Count - 1
column = dok.UsedRange.Columns.Count

r = 2
While r <= row
    kuerzelT = dok.Cells(r, 5)
    Set kuerzelT = New mitarbeiter
    'Hinzufügen des Kürzels
    kuerzelT.kuerzelP = dok.Cells(r, 5)
    'Hinzufügen Name mit  Titel " " Vorname " " Nachname
    kuerzelT.nameP = dok.Cells(r, 6) & " " & dok.Cells(r, 2) & " " & dok.Cells(r, 3)
    'Hinzufügen Funktion
    kuerzelT.fktP = dok.Cells(r, 4) & vbCrLf & dok.Cells(r, 7)
    'Mitarbeiter wird zu MitColl hinzugefügt
    kuerzelT.ansprP = dok.Cells(r, 8)

    mitColl.Add kuerzelT
    r = r + 1
Wend

For Each ccObject In ActiveDocument.ContentControls
If ccObject.Title = "erstPrim" Then
    ccObject.DropdownListEntries.Clear
    i = 1
    While i <= mitColl.Count
        ccObject.DropdownListEntries.Add (mitColl.Item(i).kuerzelP)
        i = i + 1
    Wend
End If

If ccObject.Title = "anspr" Then
    ccObject.DropdownListEntries.Clear
    i = 1
    While i <= mitColl.Count
        ccObject.DropdownListEntries.Add (mitColl.Item(i).kuerzelP)
        i = i + 1
    Wend
End If

If ccObject.Title = "erstSec" Then
    ccObject.DropdownListEntries.Clear
    i = 1
    While i <= mitColl.Count
        ccObject.DropdownListEntries.Add (mitColl.Item(i).kuerzelP)
        i = i + 1
    Wend
End If
Next
xlApp.Quit

End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)

'Erstellung von Objekten mit Referenz auf die ContentControl Objekte im Dokument
Dim ccObject As ContentControl
Dim anspr As ContentControl
Dim erstPrimLang As ContentControl
Dim erstSecLang As ContentControl
Dim erstPrimFkt As ContentControl
Dim erstSecFkt As ContentControl
Dim erstPrim As ContentControl
Dim erstSec As ContentControl


For Each ccObject In ActiveDocument.ContentControls

If ccObject.Title = "anspr" Then
    Set anspr = ccObject

ElseIf ccObject.Title = "erstPrim" Then
    Set erstPrim = ccObject

ElseIf ccObject.Title = "erstSec" Then
    Set erstSec = ccObject

ElseIf ccObject.Title = "erstPrimLang" Then
    Set erstPrimLang = ccObject

ElseIf ccObject.Title = "erstSecLang" Then
    Set erstSecLang = ccObject

ElseIf ccObject.Title = "erstPrimFkt" Then
    Set erstPrimFkt = ccObject

ElseIf ccObject.Title = "erstSecFkt" Then
    Set erstSecFkt = ccObject
End If
Next


If ContentControl.Title = "erstPrim" Then
    i = 1
    While i <= mitColl.Count
        'Debug.Print mitColl.Item(i).nameP
        If ContentControl.Range.Text = mitColl.Item(i).kuerzelP Then
            erstPrimLang.Range.Text = mitColl.Item(i).nameP
            erstPrimFkt.Range.Text = mitColl.Item(i).fktP
            anspr.Range.Text = mitColl.Item(i).ansprP
        End If
        i = i + 1
    Wend
End If

If ContentControl.Title = "erstSec" Then
    i = 1
    While i <= mitColl.Count
        If ContentControl.Range.Text = mitColl.Item(i).kuerzelP Then
            erstSecLang.Range.Text = mitColl.Item(i).nameP
            erstSecFkt.Range.Text = mitColl.Item(i).fktP
        End If

        If ContentControl.Range.Text = "-" Then
            erstSecLang.Range.Text = " "
            erstSecFkt.Range.Text = " "
        End If
        i = i + 1
    Wend

End If
End Sub