Добрый день! Столкнулся я с проблемой: при выполнении процедуры вылезает ошибка Method 'Add' of object 'ListRows' failed (Run-time error '-2147417848 (80010108) На строку [vba]
Код
Set UF_AddcontractListRow = UF_AddcontractListObj.ListRows.Add
[/vba] Сам я тот еще макроПИСЕЦ. Файлик у меня на 500 кб и его никак не обрезать и не заархивировать. Все ломается махом.
[vba]
Код
Option Explicit
Dim ShUF_Addrecipient As Worksheet Dim ShUF_Addcontract As Worksheet Dim ShUF_Addsuppl As Worksheet Dim ShUF_Main As Worksheet Dim ShUF_Addnewmedic As Worksheet Dim ShUF_AddNewContract As Worksheet
Dim UF_AddrecipientListObj As ListObject Dim UF_AddcontractListObj As ListObject Dim UF_AddsupplListObj As ListObject Dim UF_MainListObj As ListObject Dim UF_AddnewmedicListObj As ListObject Dim UF_AddNewContractListObj As ListObject
Dim UF_AddrecipientListRow As ListRow Dim UF_AddcontractListRow As ListRow Dim UF_AddsupplListRow As ListRow Dim UF_MainListRow As ListRow Dim UF_AddnewmedicListRow As ListRow Dim UF_AddNewContractListRow As ListRow
Sub Addcontract() ' добавить договор
Set ShUF_Addcontract = ThisWorkbook.Worksheets("Медикаменты") Set UF_AddcontractListObj = ShUF_Addcontract.ListObjects("Договоры_tb")
If UF_Addcontract.cbx_suppl.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите поставщика!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_NumbCont.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите договор!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_NameMedic.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите наименование МЦ!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.txb_count.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите количество!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_unit.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите единицы измерения!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
Set UF_AddcontractListRow = UF_AddcontractListObj.ListRows.Add
Переменные натыканы чисто по образу. Даже не до конца совсем их понимаю.
Эта ошибка не вылезает при определенных обстоятельствах: если в определенный момент выйти из файла, сохранив его и зайти снова. Возможно ли без файла подсказать в чем проблема?
Добрый день! Столкнулся я с проблемой: при выполнении процедуры вылезает ошибка Method 'Add' of object 'ListRows' failed (Run-time error '-2147417848 (80010108) На строку [vba]
Код
Set UF_AddcontractListRow = UF_AddcontractListObj.ListRows.Add
[/vba] Сам я тот еще макроПИСЕЦ. Файлик у меня на 500 кб и его никак не обрезать и не заархивировать. Все ломается махом.
[vba]
Код
Option Explicit
Dim ShUF_Addrecipient As Worksheet Dim ShUF_Addcontract As Worksheet Dim ShUF_Addsuppl As Worksheet Dim ShUF_Main As Worksheet Dim ShUF_Addnewmedic As Worksheet Dim ShUF_AddNewContract As Worksheet
Dim UF_AddrecipientListObj As ListObject Dim UF_AddcontractListObj As ListObject Dim UF_AddsupplListObj As ListObject Dim UF_MainListObj As ListObject Dim UF_AddnewmedicListObj As ListObject Dim UF_AddNewContractListObj As ListObject
Dim UF_AddrecipientListRow As ListRow Dim UF_AddcontractListRow As ListRow Dim UF_AddsupplListRow As ListRow Dim UF_MainListRow As ListRow Dim UF_AddnewmedicListRow As ListRow Dim UF_AddNewContractListRow As ListRow
Sub Addcontract() ' добавить договор
Set ShUF_Addcontract = ThisWorkbook.Worksheets("Медикаменты") Set UF_AddcontractListObj = ShUF_Addcontract.ListObjects("Договоры_tb")
If UF_Addcontract.cbx_suppl.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите поставщика!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_NumbCont.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите договор!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_NameMedic.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите наименование МЦ!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.txb_count.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите количество!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
If UF_Addcontract.cbx_unit.Value = "" Then UF_Main.Label_Info.ForeColor = VBA.RGB(255, 0, 0) UF_Main.Label_Info.Caption = "Укажите единицы измерения!" Exit Sub Else UF_Main.Label_Info.Caption = "" End If
Set UF_AddcontractListRow = UF_AddcontractListObj.ListRows.Add
Переменные натыканы чисто по образу. Даже не до конца совсем их понимаю.
Эта ошибка не вылезает при определенных обстоятельствах: если в определенный момент выйти из файла, сохранив его и зайти снова. Возможно ли без файла подсказать в чем проблема?AVI
Сообщение отредактировал AVI - Вторник, 14.08.2018, 17:10
Совсем не понятное. В какой-то момент макрос часть данных добавляет, а часть нет. Плюс добавляется пустая строка. А иногда выпрыгивает ошибка: Run-time error '-2147417848 (80010108)': Automation error - Вызванный объект был отключен от клиентов.
Но опять же, если в определенный момент закрыть, а потом открыть файл, то все работает.
Roman777,
Совсем не понятное. В какой-то момент макрос часть данных добавляет, а часть нет. Плюс добавляется пустая строка. А иногда выпрыгивает ошибка: Run-time error '-2147417848 (80010108)': Automation error - Вызванный объект был отключен от клиентов.
Но опять же, если в определенный момент закрыть, а потом открыть файл, то все работает.AVI
Сообщение отредактировал AVI - Вторник, 14.08.2018, 20:11