Excel自动化错误：运行时错误'-2147417848（80010108）'
我是VBA的新手（就此问题而言是Excel）所以请在审核我的代码时牢记这一点。这也是我在这里的第一篇文章！
我正在尝试完成并优化我的文件，但是我遇到了一个我似乎无法修复甚至无法理解的错误。我搜索了这个网站（以及其他许多网站）并发现许多人有同样的错误，但他们的解决方案无关紧要和/或无法解决我的问题。
这是我收到的错误：
“自动化错误。调用的对象已与其客户端断开连接。”
如果单击“调试”，“结束”或“帮助”，Excel将崩溃并（有时）重新打开已恢复的文件。太令人沮丧了！
我已设法找到导致此问题的代码行：
templateSheet.Copy After:=indexSheet
templateSheet和indexSheet是对特定工作表的定义引用
我文件的这部分内容发生的要点：
我已经创建了一个userform和一个表单控件按钮。该按钮显示用户表单。 userform有两个字段要求用户输入名称。代码（所有在userform中）检查所有工作表名称。
- 如果名称存在，它会告诉用户选择其他名称。
- 如果名称不存在，则会在主页表（indexSheet）之后复制并粘贴隐藏的模板表（templateSheet），并根据用户输入重命名。
- 主页上的表格会获得一个新行，并会添加指向新工作表的超链接。
- 还有其他代码可以为多个工作表上的单元格添加值，并为文本格式添加。
- 明确选项
- 始终保持templateSheet可见
- 创建单独的Excel模板文件并从userform 调用该文件
- 已更改.Activate和。选择到已定义的范围
- 复制并粘贴新模板表，而不指定放置位置
- 确保所有对工作表的调用都包含特定的“路径”（ThisWorkbook。）
所有这一切都适用于21次运行。在第22次运行，没有失败，弹出自动化错误，Excel崩溃。
这种情况发生在使用Excel 2010,2011和2016的Windows上（我还没有在Excel上测试其他版本）在一系列Windows版本上。 Bizzarly，该文件在我的2013 MacBook pro上使用Excel 2011完美运行..没有任何错误。
我在本文末尾提供的代码是文件中的大部分代码。起初，我认为这可能是一个内存问题，但我认为这是一个非常简单的文件，一些excel，我的桌面应该能够处理。
到目前为止我尝试修复它：
低效的解决方法：
防止此错误的唯一方法是保存，关闭和重新打开文件的代码。显然，这是耗时且效率低的。我在网上找到了这个代码：
wb.Save
Application.OnTime Now + TimeValue("00:00:01"), Application.Workbooks.Open(filePath)
wb.Close (True)
最后：
正如我所说的，我是VBA，编码和本网站的新手。我非常感谢任何与此问题相关的代码建议。我已经包含了UserForm中的所有代码。
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张后手动关闭用户窗体，然后重新打开以创建新工作表，则会再次弹出自动化错误，并且会出现崩溃。
导致此错误的新代码位于：
With templateSheet
.Visible = xlSheetVisible
.Copy Before:=indexSheet 'ERRORS HERE!!
.Visible = xlSheetVeryHidden
另外值得一提的是：在项目资源管理器中，它列出了我的所有工作表及其名称。但是，那里有额外的工作表，旁边有工作簿图标。我没有创建任何工作簿或工作表，我的宏不会创建甚至调用除ThisWorkbook之外的任何工作簿。
1 个答案:
答案 0 :(得分：0)
我不知道这是否能解决问题，但我试着稍微清理一下代码。看看这是否有帮助。我创建了大约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
相关问题
- 是什么原因导致Excel宏中的MS VB运行时错误-2147417848（80010108）
- 运行时错误-2147417848（80010108） - 方法＆＃39;偏移＆＃39;对象＆＃39;范围＆＃39;失败
- “运行时自动化错误-2147417848（80010108）”
- 运行时错误'-2147417848（80010108）'在循环中处理时随机出现
- 运行时错误'2147417848（80010108）'：对象'Range'的方法'Value'失败
- Excel自动化错误：运行时错误'-2147417848（80010108）'
- 运行时错误'-2147417848（80010108）'
- VBA运行时错误＆＃39; -2147417848（80010108）＆＃39;
- Excel：VBA脚本错误运行时错误'2147417848（80010108）'
- 运行时错误'-2147417848（80010108）'：对象'_Worksheet'的方法'Cells'失败
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？