Ошибка автоматизации 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 
  • Ошибка времени выполнения над условным форматированием в VBA
  • Ошибка выполнения 13 в цикле for i, которая использовалась для работы
  • Ошибка времени выполнения 5 - Неверная процедура Вызов или аргумент
  • «Определенная заявка или ошибка с определением объекта» - Возможность запуска сценария на некоторых ПК, но не другие
  • Ошибка выполнения VBA Excel VBA -2147319767 (80028029)
  • Ошибка выполнения «1004» Метод «Диапазон» объекта «_Global» не удался - имена динамических таблиц, циклы, поиск между рабочими листами
  • Ошибка определения объекта приложения (1004)
  • Метод Диапазон объекта Глобальный не удалось
  • VBA для загрузки файла Excel в Sharepoint. Ошибка времени выполнения «1004»
  • Доступ Ошибка выполнения «91» при работе с Excel
  • Конструктор в VBA - Ошибка выполнения 91 «Объектная переменная не установлена»
  • Interesting Posts

    Освежающие таблицы с VBA

    Соединяйте ячейки с запятой и пробелом, за исключением случаев, когда ячейка пуста / пустая

    Транспонирование нескольких ячеек из нескольких строк в одну строку в Excel

    Фиксация даты в листе (поиск строки)

    Коллекция, хранящая больше, чем предназначена для создания проблем для заявления Союза

    Openpyxl выполняет итерацию по определенным строкам в столбце на основе условия

    Я хочу получить отношение многих ко многим отношениям сопоставления, используя VBA для данного примера ниже

    Проблема с формой списка Excel при использовании заблокированного свойства

    Ошибка времени выполнения VBA 1004 Метод AutoFilter класса Range Failed

    Множественные критерии фильтра для пробелов и чисел с использованием подстановочных знаков на одном поле просто не работают

    Excel, Stop vba, который закрывает Excel, когда он открывается

    VBA Excel делает массив последовательных чисел

    Открыть книгу Excel в полноэкранном режиме

    Открытие и просмотр большого количества веб-сайтов на миниатюрных экранах

    Скопируйте строки из нескольких листов в один, затем упорядочьте по столбцу

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