Ошибка автоматизации Excel: ошибка времени выполнения '-2147417848 (80010108)'

Я новичок в VBA (и Excel в этом отношении), поэтому, пожалуйста, имейте это в виду при просмотре моего кода. Это тоже мой первый пост!

Я пытаюсь завершить и уточнить свой файл, но я столкнулся с ошибкой, которую я не могу понять или даже понять. Я искал этот сайт (и многие другие) и нашел много людей с такой же ошибкой, но их решения не имеют значения и / или не решают мою проблему.

Это ошибка, которую я получаю:

Сообщение об ошибке

«Ошибка автоматизации. Объект, вызванный, отключен от своих клиентов».

Если я нажму кнопку «Отладка», «Завершить» или «Справка», произойдет сбой Excel и (иногда) снова откроется восстановленный файл. Так разочаровывает!

Мне удалось найти строку кода, которая вызывает это:

templateSheet.Copy After:=indexSheet 

templateSheet и indexSheet – это ссылки на конкретные рабочие листы

Суть того, что происходит в этой части моего файла:

Я создал пользовательскую форму и кнопку управления формой. На кнопке отображается пользовательская форма. Пользовательская форма имеет два поля, в которых пользователю предлагается ввести имена. Код (все в пользовательской форме) проверяет все имена рабочих листов.

  1. Если имя существует, оно указывает пользователю выбрать другое имя.
  2. Если имя не существует, скрытый лист шаблона (templateSheet) копируется и вставляется после листа домашней страницы (индексный лист) и переименовывается на основе пользовательского ввода.
  3. Таблица на домашней странице получает новую строку и добавляется гиперссылка на новый лист.
  4. Существует дополнительный код, который добавляет значения ячейкам на нескольких листах и ​​форматирует этот текст.

Все это отлично работает на 21 пробег. На 22-м запуске обязательно появляется ошибка автоматизации и сбои Excel.

Это происходит в Windows с Excel 2010, 2011 и 2016 (я еще не тестировал другие версии в Excel) в ряде версий Windows. Bizzarly, файл работает СОВЕРШЕННО на моем MacBook Pro 2013 года с Excel 2011 .. никаких ошибок вообще.

Код, который я предоставляю в конце этого сообщения, является большей частью кода внутри файла. Сначала я подумал, что это проблема памяти, но я думаю, что это довольно простой файл, что-то отличное, и мой рабочий стол должен справиться.

Что я сделал до сих пор, чтобы попытаться это исправить:

  • Вариант явный
  • Хранить шаблонную таблицу в любое время
  • Создайте отдельный файл шаблона Excel и вызовите его из пользовательской формы
  • Изменено. Активировать и. Выбрать в определенные диапазоны
  • Скопируйте и вставьте новый лист шаблона без указания места его размещения.
  • Убедитесь, что все обращения к листам включали конкретный «путь» (ThisWorkbook.)

Неэффективное обходное решение:

Единственное, что предотвращает эту ошибку, – это код для сохранения, закрытия и повторного открытия файла. Очевидно, что это занимает много времени и неэффективно. Я нашел этот код онлайн:

  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 

Еще одна вещь, о которой стоит упомянуть: в проводнике проекта перечислены все мои листы с их именами. Но есть дополнительные листы, в которых есть значок рабочей книги рядом с ними. Я не создал ни одной книги или рабочих листов, и мои макросы не создают или даже не называют какую-либо книгу, кроме этой книги.

Я не знаю, удастся ли это решить проблему, но я попытался немного почистить код. Посмотрите, поможет ли это. Я создал около 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 
  • Ошибка выполнения 9 в цикле
  • Ошибка выполнения 438 при импорте данных в Excel с защищенного веб-сайта с использованием VBA
  • Адресация OLE-объекта в ppt через excel иногда возвращает ошибку времени выполнения 430
  • Ошибка времени выполнения 424 Началось без предупреждения
  • Авария произошла за пределами виртуальной машины Java в ошибке внутреннего кода при редактировании файлов excel
  • Ошибка Runtime Ошибка 13 типа Excel
  • Ошибка выполнения в проекте VBA
  • Аргумент VBA не является необязательной ошибкой userfrom listbox
  • Ошибка времени выполнения 1004 над надстройкой: файл не может быть обработан, потому что он доступен только для чтения
  • Ввод Excel VBA в SAP и извлечение электронной таблицы - застрял в Excel
  • Ошибка времени выполнения '13' VBA Macro Excel
  • Interesting Posts

    VBA Excel – динамический номер страницы (листов) колонтитула и нижнего колонтитула

    Excel VBA находит все значения в строке и сохраняет разные значения столбца для переменных

    Изменить имя столбца в MATLAB

    попытка войти в facebook с помощью VBA

    обновление результатов макроса с помощью кнопки excel

    как переполнять текст в excel C # / VB.Net

    Excel VBA: Итерационный код, но нужен второй или третий экземпляр класса DIV

    Fidder не захватывает трафик Power Query в MS Excel

    Вызов функций Excel / DLL / XLL из C #

    ui-grid экспорт в таблицу csv с заголовком с несколькими столбцами

    Как вы выполняете цикл через массив с помощью VBA?

    excel: отменять диапазон после запуска макроса

    Excel VBA на веб-странице: не заполнение текстового поля

    Как я могу экспортировать отчет служб отчетов в Excel с помощью встроенных вычислений в столбцах excel?

    Загрузка файла Excel с помощью метода действия JSF приводит к добавлению некоторых странных символов и добавлению завершенной страницы JSP

    Давайте будем гением компьютера.