通过代码添加 Word 对象库后显示'Compile Error: User-defined type not defined'错误

Question

我是VBA编程的新手，这是我在论坛上的第一篇帖子，所以如果我犯了任何错误，我想提前道歉。

我正在自动化一个Excel工作簿，该工作簿打开并使用模板中的新Word文件。我正在使用"WithEvents"跟踪Word中的应用程序事件。我还使用代码在关闭工作簿时删除单词对象库引用，然后在"workbook_Open"中再次添加它们，以确保此工作簿可以在其他具有不同版本单词的计算机上运行。

除了每次打开工作簿时都会出现"编译错误：用户定义的类型未定义"错误外，其他一切都按预期进行，但随后的编译工作顺利。我知道是什么导致了它——在第一次编译尝试中没有引用word对象库，因此编译器不知道"word.Application"是什么，但从第二次开始，它知道，因此不会产生错误。

我就是不知道该怎么解决这个问题。我研究过LateBinding，但从研究中我发现WithEvents与LateBindiing不兼容。任何帮助都将不胜感激。

提前感谢您抽出时间。

'ThisWorkbook'
'------------'
Option Explicit
Private Sub Workbook_Open()
ThisWorkbook.VBProject.References.AddFromGuid GUID:="{00020905-0000-0000-C000-000000000046}", Major:=0, Minor:=0
ThisWorkbook.VBProject.References.AddFromGuid GUID:="{00062FFF-0000-0000-C000-000000000046}", Major:=0, Minor:=0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If IsEmpty(ThisWorkbook.VBProject.References.Item("Word")) = False Then
ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References.Item("Word")
End If
If IsEmpty(ThisWorkbook.VBProject.References.Item("Outlook")) = False Then
ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References.Item("Outlook")
End If
ActiveWorkbook.Save
Set wdAppClass = Nothing
Set wdAppClass.wdApp = Nothing
'Set wdApp = Nothing
Set wdDoc = Nothing
Set button = Nothing
End Sub

-

'Module1'
'-------'
Option Explicit
Public wdAppClass As New wdAppClass
Public wdDoc As Word.Document
Public button As Object
Public row As Integer
Public column As Integer
Public Sub AutoOpen()
Set wdAppClass.wdApp = Word.Application
End Sub
Sub Button_Click()
Set wdAppClass.wdApp = Word.Application
Set button = ActiveSheet.Buttons(Application.Caller)
With button.TopLeftCell
row = .row
column = .column
End With
Set wdAppClass.wdApp = CreateObject("Word.Application")
Set wdDoc = wdAppClass.wdApp.Documents.Add(ThisWorkbook.Path & "Sales Call Report.dotm")
With wdDoc
.Fields(3).Code.Text = " Quote " & """" & ActiveSheet.Range("A" & row & "").Text & """" & " "
.Fields(4).Code.Text = " Quote " & """" & ActiveSheet.Range("B" & row & "").Text & """" & " "
.Fields(5).Code.Text = " Quote " & """" & ActiveSheet.Range("C" & row & "").Text & """" & " "
.Fields(6).Code.Text = " Quote " & """" & ActiveSheet.Range("D" & row & "").Text & """" & " "
.Fields(7).Code.Text = " Quote " & """" & ActiveSheet.Range("E" & row & "").Text & """" & " "
.Fields(8).Code.Text = " Quote " & """" & ActiveSheet.Range("H" & row & "").Text & """" & " "
.Fields(9).Code.Text = " Quote " & """" & ActiveSheet.Range("J" & row & "").Text & """" & " "
.Shapes(1).TextFrame.TextRange.Text = ActiveSheet.Range("F" & row & "").Text
.Shapes(2).TextFrame.TextRange.Text = ActiveSheet.Range("K" & row & "").Text
'.Shapes(3).TextFrame.TextRange.Text = ActiveSheet.Range("M" & row & "").Text
End With
wdAppClass.wdApp.Selection.WholeStory
wdAppClass.wdApp.Selection.Fields.Update
wdAppClass.wdApp.Selection.Collapse
wdAppClass.wdApp.Visible = True
wdAppClass.wdApp.ActiveWindow.WindowState = wdWindowStateMaximize
wdAppClass.wdApp.ActiveWindow.SetFocus
wdAppClass.wdApp.Activate
End Sub
Sub Set_Reminder()
Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
If button Is Nothing Then
Set button = ActiveSheet.Buttons(Application.Caller)
End If
With button.TopLeftCell
row = .row
column = .column
End With
On Error Resume Next
Set olApp = GetObject("", "Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
On Error Resume Next
Set olApp = CreateObject("Outlook.Application")
On Error GoTo 0
If olApp Is Nothing Then
MsgBox "Outlook is not available!"
Exit Sub
End If
End If
Set olAppt = olApp.CreateItem(olAppointmentItem)
With olAppt
.Start = ThisWorkbook.ActiveSheet.Range("M" & row & "").Value & Chr(32) & Time()
.Duration = 15
.Subject = "Call " & ThisWorkbook.ActiveSheet.Range("D" & row & "").Value
.Location = ThisWorkbook.ActiveSheet.Range("A" & row & "").Value & Chr(44) & Chr(32) & ThisWorkbook.ActiveSheet.Range("C" & row & "").Value
.Save
.Display
End With
Set olApp = Nothing
Set olAppt = Nothing
Set button = Nothing
End Sub

-

'wdAppClass'
'----------'
Option Explicit
Public WithEvents wdApp As Word.Application
Private Sub wdApp_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
Dim datecheck As Boolean
ThisWorkbook.ActiveSheet.Range("F" & row & "").Value = wdDoc.Shapes(1).TextFrame.TextRange.Text
ThisWorkbook.ActiveSheet.Range("K" & row & "").Value = wdDoc.Shapes(2).TextFrame.TextRange.Text
datecheck = IsDate(wdDoc.Shapes(3).TextFrame.TextRange.Text)
If datecheck = True Then
ThisWorkbook.ActiveSheet.Range("M" & row & "").Value = wdDoc.Shapes(3).TextFrame.TextRange.Text
Set_Reminder
End If
wdAppClass.wdApp.Quit
wdApp.Quit
wdDoc.Close
Set wdAppClass = Nothing
Set wdAppClass.wdApp = Nothing
Set wdApp = Nothing
Set wdDoc = Nothing
Set button = Nothing
End Sub

Answer 1

打开工作簿时，模块和类模块似乎是首先编译的。尝试在工作表中使用Public WithEvents wdApp As Word.Application，以便在Workbook_Open之后对其进行编译。