Word VBA引用Excel工作表报错：对象'_Global'方法调用失败

我在MS Word中编写宏，用于将文档表格数据复制到本地Excel文件的指定列。Word文档包含提交按钮，点击后会向Excel新增数据行，所有提交内容同步至主电子表格。运行宏时Excel会打开，但随即弹出错误：

运行时错误'1004'：对象'_Global'的'Worksheets'方法调用失败。

不确定是宏尝试创建多个Excel副本，还是对象引用存在问题，相关VBA代码如下：

Sub CommandButton1_Click()
    
    '// Declare Excel Objects
    Dim xlApp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim sh As Worksheet
    Dim lr As Long
    
    '// Declare Word Objects
    Dim doc As Document
    Dim tbl As Table
    Dim tbl2 As Table
    Dim tbl8 As Table
    
    Dim LastRow As Long, LastColumn As Integer
    Dim tblRange1 As Variant 'Range
    Dim tblRange2 As Variant 'Range
    Dim tblRange3 As Variant 'Range
    Dim tblRange4 As Variant 'Range
    Dim tblRange5 As Variant 'Range
    Dim tblRange6 As Variant 'Range
    Dim tblRange7 As Variant 'Range
    Dim tblRange8 As Variant 'Range
    Dim tblRange9 As Variant 'Range
    Dim tblRange10 As Variant 'Range
    
    Dim AnswerYes As String
    Dim AnswerNo As String
    
    Set doc = ThisDocument
      
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    'Open Workbook
    Set xlwb = xlApp.Workbooks.Open("C:\Users\Test Document.xlsm")
    Set sh = Worksheets("CHECKLIST")
     
    AnswerYes = MsgBox("Do you want to Submit Application?", vbQuestion + vbYesNo, "User Repsonse")
    
    If AnswerYes = vbYes Then
    
        Set tbl = doc.Tables(1)
        Set tbl2 = doc.Tables(2)
        Set tbl8 = doc.Tables(8)
        
        lr = sh.Cells(Rows.Count, 3).End(xlUp).Row + 1
        
        With tbl
            Set tblRange1 = .Cell(1, 3).Range ' Value from Word Document (Last Name)
            tblRange1.Copy
            sh.Cells(lr, "D").PasteSpecial xlPasteValues
            
            Set tblRange2 = .Cell(1, 4).Range ' Value from Word Document (First Name)
            tblRange2.Copy
            sh.Cells(lr, "C").PasteSpecial xlPasteValues
            
            Set tblRange3 = .Cell(3, 7).Range ' Value from Word Document (Phone)
            tblRange3.Copy
            sh.Cells(lr, "E").PasteSpecial xlPasteValues
            
            Set tblRange4 = .Cell(5, 9).Range ' Value from Word Document (Email)
            tblRange4.Copy
            sh.Cells(lr, "F").PasteSpecial xlPasteValues
            
            Set tblRange6 = .Cell(1, 9).Range ' Value from Word Document (Date of Application)
            tblRange6.Copy
            sh.Cells(lr, "T").PasteSpecial xlPasteValues
            
            Set tblRange7 = .Cell(3, 3).Range ' Value from Word Document (Address)
            tblRange7.Copy
            sh.Cells(lr, "I").PasteSpecial xlPasteValues
            
            Set tblRange8 = .Cell(5, 3).Range ' Value from Word Document (City)
            tblRange8.Copy
            sh.Cells(lr, "J").PasteSpecial xlPasteValues
            
            Set tblRange9 = .Cell(5, 4).Range ' Value from Word Document (State)
            tblRange9.Copy
            sh.Cells(lr, "K").PasteSpecial xlPasteValues
            
            Set tblRange10 = .Cell(5, 5).Range ' Value from Word Document (Zip)
            tblRange10.Copy
            sh.Cells(lr, "L").PasteSpecial xlPasteValues
        End With
        
        With tbl2
            Set tblRange10 = .Cell(1, 4).Range ' Value from Word Document (SSN)
            tblRange10.Copy
            sh.Cells(lr, "H").PasteSpecial xlPasteValues
        End With
        
        With tbl8
            Set tblRange10 = .Cell(1, 3).Range ' Value from Word Document (DOB)
            tblRange10.Copy
            sh.Cells(lr, "G").PasteSpecial xlPasteValues
        End With
        
        MsgBox (" Your Application has been Submitted!  ")
        
        '//Close obj Instance
        Set xlwb = Nothing
        Set xlApp = Nothing
        
        Set tbl = Nothing
        Set doc = Nothing
        
    Else
       'Range("A1:A2").Copy Range("E1")
    End If
    
    doc.Close
    xlApp.Quit
    Set sh = Nothing
    
End Sub

错误根源 #

触发错误的核心原因是对象引用不明确：在Word VBA环境中，直接调用Worksheets("CHECKLIST")会默认尝试访问Word的对象模型，但Word并没有Worksheets对象，必须明确指定该工作表属于你打开的Excel工作簿实例。

修改步骤 #

1. 修正工作表引用
   将：

Set sh = Worksheets("CHECKLIST")

改为：

Set sh = xlwb.Worksheets("CHECKLIST")

这行代码明确指定sh是xlwb（你打开的Excel工作簿）中的工作表。

2. 修正文件路径
   注意你的Excel文件路径C:\Users\Test Document.xlsm不完整，Users目录下需要指定具体用户名，比如：

Set xlwb = xlApp.Workbooks.Open("C:\Users\YourUsername\Test Document.xlsm")

替换YourUsername为实际系统用户名。

3. 优化对象释放与程序逻辑

• 释放对象的顺序要调整，先关闭Excel再释放对象，避免出现对象已被释放的错误；
• 避免使用复制粘贴，直接赋值效率更高，比如把tblRange1.Copy + PasteSpecial改为：

  sh.Cells(lr, "D").Value = Left(tbl.Cell(1, 3).Range.Text, Len(tbl.Cell(1, 3).Range.Text) - 2)
  

  （Word表格单元格的Range.Text会包含额外的结束标记，用Left去掉最后两个字符）

修改后的完整代码示例 #

Sub CommandButton1_Click()
    
    '// Declare Excel Objects
    Dim xlApp As Excel.Application
    Dim xlwb As Excel.Workbook
    Dim sh As Worksheet
    Dim lr As Long
    
    '// Declare Word Objects
    Dim doc As Document
    Dim tbl As Table
    Dim tbl2 As Table
    Dim tbl8 As Table
    
    Dim AnswerYes As VbMsgBoxResult
    
    Set doc = ThisDocument
      
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    'Open Workbook - 替换为正确的文件路径
    Set xlwb = xlApp.Workbooks.Open("C:\Users\YourUsername\Test Document.xlsm")
    '明确指定工作表所属的工作簿
    Set sh = xlwb.Worksheets("CHECKLIST")
     
    AnswerYes = MsgBox("Do you want to Submit Application?", vbQuestion + vbYesNo, "User Response")
    
    If AnswerYes = vbYes Then
    
        Set tbl = doc.Tables(1)
        Set tbl2 = doc.Tables(2)
        Set tbl8 = doc.Tables(8)
        
        lr = sh.Cells(xlApp.Rows.Count, 3).End(xlUp).Row + 1
        
        '直接赋值替代复制粘贴，提升效率
        With tbl
            'Last Name
            sh.Cells(lr, "D").Value = Left(.Cell(1, 3).Range.Text, Len(.Cell(1, 3).Range.Text) - 2)
            'First Name
            sh.Cells(lr, "C").Value = Left(.Cell(1, 4).Range.Text, Len(.Cell(1, 4).Range.Text) - 2)
            'Phone
            sh.Cells(lr, "E").Value = Left(.Cell(3, 7).Range.Text, Len(.Cell(3, 7).Range.Text) - 2)
            'Email
            sh.Cells(lr, "F").Value = Left(.Cell(5, 9).Range.Text, Len(.Cell(5, 9).Range.Text) - 2)
            'Date of Application
            sh.Cells(lr, "T").Value = Left(.Cell(1, 9).Range.Text, Len(.Cell(1, 9).Range.Text) - 2)
            'Address
            sh.Cells(lr, "I").Value = Left(.Cell(3, 3).Range.Text, Len(.Cell(3, 3).Range.Text) - 2)
            'City
            sh.Cells(lr, "J").Value = Left(.Cell(5, 3).Range.Text, Len(.Cell(5, 3).Range.Text) - 2)
            'State
            sh.Cells(lr, "K").Value = Left(.Cell(5, 4).Range.Text, Len(.Cell(5, 4).Range.Text) - 2)
            'Zip
            sh.Cells(lr, "L").Value = Left(.Cell(5, 5).Range.Text, Len(.Cell(5, 5).Range.Text) - 2)
        End With
        
        With tbl2
            'SSN
            sh.Cells(lr, "H").Value = Left(.Cell(1, 4).Range.Text, Len(.Cell(1, 4).Range.Text) - 2)
        End With
        
        With tbl8
            'DOB
            sh.Cells(lr, "G").Value = Left(.Cell(1, 3).Range.Text, Len(.Cell(1, 3).Range.Text) - 2)
        End With
        
        MsgBox "Your Application has been Submitted!"
        
    Else
       '此处可添加取消操作的逻辑
    End If
    
    '先关闭文档和Excel，再释放对象
    doc.Close SaveChanges:=False '根据需求设置是否保存
    xlwb.Save '保存Excel修改
    xlApp.Quit
    
    '释放对象
    Set sh = Nothing
    Set xlwb = Nothing
    Set xlApp = Nothing
    Set tbl = Nothing
    Set tbl2 = Nothing
    Set tbl8 = Nothing
    Set doc = Nothing
    
End Sub

内容的提问来源于stack exchange，提问作者Jarvis Davis