Question

我是VBA节目的新手，这是我在论坛上发表的第一篇文章，所以我想事先道歉，以防我犯错误。

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

每次打开工作簿时，除了“编译错误：未定义的用户定义类型”错误之外，所有内容都按预期工作，但随后的编译工作正常，没有任何障碍。我知道是什么导致它 - 在第一次编译试验期间没有对单词对象库的引用，因此编译器不知道'Word.Application'是什么，但是从第二个实例开始它不会产生错误。

我无法理解如何解决这个问题。我已经研究过LateBinding但是从研究中我发现WithEvents与LateBinding不兼容。任何帮助将不胜感激。

提前感谢您的时间。

'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之后编译。

通过代码添加单词对象库后显示“编译错误：未定义的用户定义类型”错误

1 个答案: