Excel 自动化错误：运行时错误“-2147417848 (80010108)”

Question

我是 VBA（以及 Excel）的新手，所以在查看我的代码时请牢记这一点。这也是我在这里的第一篇文章！

我正在尝试完成和优化我的文件，但我遇到了一个我似乎无法修复甚至无法理解的错误。我搜索了这个网站（以及许多其他网站），发现很多人都有同样的错误，但他们的解决方案无关紧要和/或不能解决我的问题。

这是我收到的错误：

“自动化错误。调用的对象已与其客户端断开连接。”

如果我单击调试、结束或帮助，Excel 会崩溃并且（有时）会重新打开已恢复的文件。太令人沮丧了！

我已设法找到导致此问题的代码行：

templateSheet.Copy After:=indexSheet

templateSheet 和 indexSheet 是对特定工作表的定义引用

我的文件这部分发生的事情的要点：

我创建了一个用户表单和一个表单控制按钮。该按钮显示用户窗体。用户表单有两个字段要求用户输入名称。代码（全部在用户表单中）检查所有工作表名称。

1. 如果名称存在，它会告诉用户选择其他名称。
2. 如果名称不存在，则会在主页表 (indexSheet) 之后复制并粘贴隐藏的模板表 (templateSheet)，并根据用户输入进行重命名。
3. 主页上的表格获得新行，并添加指向新工作表的超链接。
4. 还有额外的代码可以为多个工作表上的单元格添加值并设置文本格式。

所有这些都可以完美运行 21 次。第22次运行，不出意外，自动弹出错误，Excel崩溃。

在一系列 Windows 版本上使用 Excel 2010、2011 和 2016（我尚未在 Excel 上测试其他版本）的 Windows 上会发生这种情况。奇怪的是，该文件在我的带有 Excel 2011 的 2013 MacBook pro 上完美运行。完全没有错误。

我在本文末尾提供的代码是文件中的大部分代码。起初，我认为这可能是内存问题，但我认为这是一个非常简单的文件，excel 和我的桌面应该能够处理。

到目前为止我为修复它所做的工作：

• 选项显式
• 始终保持 templateSheet 可见
• 创建一个单独的 Excel 模板文件并从用户窗体调用它
• 已将 .Activate 和 .Select 更改为定义的范围
• 复制并粘贴新模板表，但不指定放置位置
• 确保所有对工作表的调用都包含特定的“路径”（ThisWorkbook。）

低效的解决方法：

防止此错误的唯一方法是保存、关闭和重新打开文件的代码。显然，这是耗时且效率不高的。我在网上找到了这段代码：

    wb.Save
    Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
    wb.Close (True)

最后：

正如我所说，我是 VBA、编码和这个网站的新手。非常感谢对我的代码提出的任何建议，无论是否与此问题相关。我已经包含了我的用户窗体中的所有代码。

Private Sub OkButton_Click()

'Dont update the screen while the macro runs
Application.ScreenUpdating = False

    'Sheet and workbook variables
    Dim wb As Workbook
    Dim indexSheet As Worksheet, templateSheet As Worksheet
    Dim templateCopy As Worksheet, newSheet As Worksheet

    'Table and new row variables
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    'Variables to group shapes based on
    'need to hide or show them
    Dim hideShapes() As Variant, showShapes() As Variant
    Dim hideGroup As Object, showGroup As Object

    'Misc variables
    Dim i As Integer
    Dim exists As Boolean
    Dim filePath As String

    'Variables to assign ranges
    Dim scenarioRng As Range
    Dim traceabilityFocus As Range
    Dim testCaseRng As Range
    Dim statusRng As Range
    Dim newSheetTestCaseRng As Range
    Dim newSheetStatusRng As Range
    Dim newSheetFocus As Range
    Dim newSheetDateRng As Range

    'Create array of shapes based on visibility rules
    hideShapes = Array("TextBox 2", "Rectangle 1")
    showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")

    'To reference Traceability Matrix sheet
    Set indexSheet = ThisWorkbook.Sheets("Traceability Matrix")
    'To reference Template sheet
    Set templateSheet = ThisWorkbook.Sheets("TestCase_Template")
    'To reference traceability matrix table
    Set Tbl = indexSheet.ListObjects("TMatrix")
    'Set hideShapes to a hide group
    Set hideGroup = indexSheet.Shapes.Range(hideShapes)
    'Set show shapes to a show group
    Set showGroup = indexSheet.Shapes.Range(showShapes)
    'To reference this workbook
    Set wb = ThisWorkbook
    'Get file path of this workbook and set it to string
    filePath = wb.FullName


    'If the userform fields are empty then show error message
    If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
            MsgBox ("Please complete both fields.")
    'If the userform fields are completed and a worksheet with
    'the same name exists, set boolean to true
    Else
        For i = 1 To Worksheets.Count
        If ThisWorkbook.Worksheets(i).Name = TestCaseNameBox.Value Then
            exists = True
    End If
    'Iterate through all worksheets
    Next i

    'If test case name already exists, show error message
    If exists Then
        MsgBox ("This test case name is already in use. Please choose another name.")
    'If test case name is unique, update workbook
    Else
        'Copy template sheet to after traceability matrix sheet
        templateSheet.Copy After:=indexSheet 'LOCATION OF ERROR!!!
        'Ensure template sheet is hidden
        templateSheet.Visible = False

        'To reference copy of template
        Set templateCopy = ThisWorkbook.Sheets("TestCase_Template (2)")

        'Rename template sheet to the test case name
        templateCopy.Name = TestCaseNameBox.Value
        'To reference re-named template sheet
        Set newSheet = ThisWorkbook.Sheets(TestCaseNameBox.Value)
        'Show new sheet
        newSheet.Visible = True

        'Set focus to traceability matrix
        Set traceabilityFocus = indexSheet.Range("A1")

        'Add a new row
        Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)

        'Set ranges for cells in traceability table
        Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
        Set testCaseRng = scenarioRng.Offset(0, 1)
        Set statusRng = testCaseRng.Offset(0, 1)

        'Set scenario cell with name and format
        With scenarioRng
            .FormulaR1C1 = ScenarioNameBox.Value
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set test case cell with name, hyperlink to sheet, and format
        With testCaseRng
            .FormulaR1C1 = TestCaseNameBox.Value
            .Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set trial status as Incomplete and format
        With statusRng
            'Set new test case to "Incomplete"
            .Value = "Incomplete"
            .Font.Name = "Arial"
            .Font.Size = 12
            .Font.Color = vbBlack
        End With

        'Show or hide objects
        hideGroup.Visible = False
        showGroup.Visible = True

        'Set ranges for cells in test case table
        Set newSheetTestCaseRng = newSheet.Range("C2")
        Set newSheetStatusRng = newSheet.Range("C12")
        Set newSheetDateRng = newSheet.Range("C5")

        'Insert test case name into table
        newSheetTestCaseRng.Value = TestCaseNameBox.Value
        'Add todays date to Date Created
        newSheetDateRng.Value = Date
        'Set status to "Incomplete"
        newSheetStatusRng.Value = "Incomplete"
        'End with cursor at beginning of table
        newSheet.Activate
        Range("C3").Activate


        'wb.Save
        'Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
        'wb.Close (True)


        'Close the userform
        Unload Me

        End If

    End If

    'Update screen
    Application.ScreenUpdating = True

End Sub

================================================ ==============================

更新：

使用@DavidZemens 提供的代码，错误的行为会有所不同。通常，用户窗体会在每张工作表创建后关闭。 @DavidZemens 建议让表单保持打开状态，以便用户可以一次性制作所需数量的表格。这种方法允许我创建看似无限数量的工作表而不会出错。阅读：在 22 张标记处，没有错误。

但是，如果我在制作超过 22 张工作表后手动关闭用户窗体，然后重新打开它以创建新工作表，则会再次弹出自动化错误并导致 excel 崩溃。

导致这个错误的新代码在这里：

 With templateSheet
        .Visible = xlSheetVisible
        .Copy Before:=indexSheet 'ERRORS HERE!!
        .Visible = xlSheetVeryHidden

另一件值得一提的事情：在项目浏览器中，它列出了我所有的工作表及其名称。但是，那里有额外的工作表，旁边有工作簿图标。我没有创建任何工作簿或工作表，我的宏没有创建甚至调用除 ThisWorkbook 之外的任何工作簿。

Answer 1

我不知道这是否能解决问题，但我尝试稍微清理一下代码。看看这是否有帮助。我创建了大约 28 张纸，没有任何错误。

有一些整合/清理，但我不认为这是实质性的。但是，我确实删除了对 Unload Me 的调用，这不是绝对必要的（用户始终可以手动关闭表单，并且通过省略该行，我们还允许用户创建任意数量的工作表，而无需每次都必须重新启动表单）。

Option Explicit
Private Sub OkButton_Click()

'Dont update the screen while the macro runs
Application.ScreenUpdating = False

    'Sheet and workbook variables
    Dim wb As Workbook
    Dim indexSheet As Worksheet, templateSheet As Worksheet
    Dim templateCopy As Worksheet, newSheet As Worksheet

    'Table and new row variables
    Dim Tbl As ListObject
    Dim NewRow As ListRow

    'Variables to group shapes based on
    'need to hide or show them
    Dim hideShapes() As Variant, showShapes() As Variant
    Dim hideGroup As Object, showGroup As Object

    'Misc variables
    Dim i As Integer
    Dim exists As Boolean
    Dim filePath As String

    'Variables to assign ranges
    Dim scenarioRng As Range
    Dim traceabilityFocus As Range
    Dim testCaseRng As Range
    Dim statusRng As Range
    Dim newSheetTestCaseRng As Range
    Dim newSheetStatusRng As Range
    Dim newSheetFocus As Range
    Dim newSheetDateRng As Range

    'Create array of shapes based on visibility rules
    hideShapes = Array("TextBox 2", "Rectangle 1")
    showShapes = Array("TextBox 15", "TextBox 14", "TextBox 13", "TextBox 11", "StatsRec", "Button 10")
    'To reference this workbook
    Set wb = ThisWorkbook
    'To reference Traceability Matrix sheet
    Set indexSheet = wb.Sheets("Traceability Matrix")
    'To reference Template sheet
    Set templateSheet = wb.Sheets("TestCase_Template")
    'To reference traceability matrix table
    Set Tbl = indexSheet.ListObjects("TMatrix")
    'Set hideShapes to a hide group
    Set hideGroup = indexSheet.Shapes.Range(hideShapes)
    'Set show shapes to a show group
    Set showGroup = indexSheet.Shapes.Range(showShapes)
    'Get file path of this workbook and set it to string
    filePath = wb.FullName

    'If the userform fields are empty then show error message
    If ScenarioNameBox.Value = "" Or TestCaseNameBox.Text = "" Then
            MsgBox "Please complete both fields."
            GoTo EarlyExit
    'If the userform fields are completed and a worksheet with
    'the same name exists, set boolean to true
    Else
        On Error Resume Next
        Dim tmpWS As Worksheet
        ' This will error if sheet doesn't exist
        Set tmpWS = wb.Worksheets(TestCaseNameBox.Value)
        exists = Not (tmpWS Is Nothing)
        On Error GoTo 0
    End If

    'If test case name already exists, show error message
    If exists Then
        MsgBox "This test case name is already in use. Please choose another name."
        GoTo EarlyExit
    'If test case name is unique, update workbook
    Else
        'Copy template sheet to after traceability matrix sheet
        With templateSheet
            .Visible = xlSheetVisible
            .Copy Before:=indexSheet
            .Visible = xlSheetVeryHidden
        End With
        Set newSheet = wb.Sheets(indexSheet.Index - 1)
        With newSheet
            newSheet.Move After:=indexSheet
            'Rename template sheet to the test case name
            .Name = TestCaseNameBox.Value
            'To reference re-named template sheet
            .Visible = True
            'Set ranges for cells in test case table
            Set newSheetTestCaseRng = .Range("C2")
            Set newSheetStatusRng = .Range("C12")
            Set newSheetDateRng = .Range("C5")

            'Insert test case name into table
            newSheetTestCaseRng.Value = TestCaseNameBox.Value
            'Add todays date to Date Created
            newSheetDateRng.Value = Date
            'Set status to "Incomplete"
            newSheetStatusRng.Value = "Incomplete"
            'End with cursor at beginning of table
            .Activate
            .Range("C3").Activate
        End With

        'Set focus to traceability matrix
        Set traceabilityFocus = indexSheet.Range("A1")
        'Add a new row
        Set NewRow = Tbl.ListRows.Add(AlwaysInsert:=True)
        'Set ranges for cells in traceability table
        Set scenarioRng = indexSheet.Range("B" & NewRow.Range.Row)
        Set testCaseRng = scenarioRng.Offset(0, 1)
        Set statusRng = testCaseRng.Offset(0, 1)

        'Set scenario cell with name and format
        With scenarioRng
            .FormulaR1C1 = ScenarioNameBox.Value
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set test case cell with name, hyperlink to sheet, and format
        With testCaseRng
            .FormulaR1C1 = TestCaseNameBox.Value
            .Hyperlinks.Add Anchor:=testCaseRng, Address:="", SubAddress:=newSheet.Name & "!A1", TextToDisplay:=newSheet.Name
            .HorizontalAlignment = xlGeneral
            .Font.Name = "Arial"
            .Font.Size = 12
        End With

        'Set trial status as Incomplete and format
        With statusRng
            'Set new test case to "Incomplete"
            .Value = "Incomplete"
            .Font.Name = "Arial"
            .Font.Size = 12
            .Font.Color = vbBlack
        End With

        'Show or hide objects
        hideGroup.Visible = False
        showGroup.Visible = True

        wb.Save
    End If

EarlyExit:
    'Update screen
    Application.ScreenUpdating = True

End Sub