Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Ошибка про программном добавлении макроса в модуль нового листа
 

Добрый день!
У меня Excel 2010. Сделал макрос, который открывает файл формата html, переносит лист с загруженными данными в ThisWorkbook, переименовывает лист в "EGRN" и в модуль этого нового листа добавляет текст макроса для события SelectionChange. Лист "EGRN" периодически создается новый, поэтому и макрос для SelectionChange приходится все время добавлять на новый лист. Код для добавления текста макроса в модуль нашел в интернете.
Но макрос ведет себя странно - то все работает нормально, то возникает ошибка 9 в этой строке:
With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets("EGRN").CodeName).CodeModule
и текст макроса для события SelectionChange в модуль листа EGRN не добавляется.
Точно отловить, в каком случае возникает ошибка, не получается. В большинстве случаев в первый раз после отладки (компиляции и сохранения файла) макрос срабатывает нормально, а потом, после удаления листа EGRN при загрузке нового html возникает ошибка. Но ошибка возникает не всегда!
Буду признателен на подсказку, что я сделал не так. Спасибо!

Код
 
 Sub OpenHTML()
 fff = Application.GetOpenFilename("Все веб-страницы,*.html")
 If fff = "False" Then Exit Sub
 Workbooks.Open (fff)
 ActiveWorkbook.Sheets(1).Name = "EGRN"
 ActiveWorkbook.Sheets("EGRN").Move After:=ThisWorkbook.Sheets("REPORT")
 Dim lLineNum As Long
 With ThisWorkbook.VBProject.VBComponents(ThisWorkbook.Sheets("EGRN").CodeName).CodeModule
     lLineNum = .CreateEventProc("SelectionChange", "Worksheet")
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "Static previous_selection As String"
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "If previous_selection <> """" Then"
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "Range(previous_selection).Interior.ColorIndex = xlColorIndexNone"
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "End If"
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "Target.Interior.Color = vbYellow"
     lLineNum = lLineNum + 1
     .InsertLines lLineNum, "previous_selection = Target.Address"
 End With
 ThisWorkbook.VBProject.VBE.mainwindow.Visible = False
 End Sub

Изменено: Leo Grig - 17 Сен 2018 12:47:51
 
Я бы посововетовал не создавать каждый раз событие листа, а использовать событие из ЭтаКнига - Workbook_SheetSelectionChange. А там просто делать проверку на имя листа:
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.name = "OGRN" then
    'выполняем нужный код
    end if
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
или копировать лист (копируется вместе с кодом) и работает по тем же правилам, что и оригинал
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
Ігор Гончаренко написал:
или копировать лист
Игорь, там лист и копируется, но он копируется из html файла, открытого в Excel, как я понял. И кода там точно нет.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Как выкрутиться, я в общем-то понимаю. Собирался использовать вариант, который предложил  Ігор Гончаренко - создать скрытый лист с макросом в модуле листа как образец, при необходимости дублировать лист и в него вставлять данные из html (вместо сохранения html как нового листа). Про вариант Workbook_SheetSelectionChange почему-то не подумал, спасибо, Дмитрий!
Но очень хочется понять, почему макрос ведет себя так странно - то срабатывает, то не срабатывает. Никак не удается стабилизировать ошибку.
 
Цитата
Leo Grig написал:
ошибка 9
Это Subscript out of range и возникает при обращении к несуществующему элементу коллекции. Либо Sheets, либо VBComponents. Попробуйте локализовать причину, вычисляя выражение поэтапно
Код
set x = ThisWorkbook.Sheets("EGRN")
set x = ThisWorkbook.VBProject.VBComponents(x.CodeName)
with x.CodeModule
 
Попробовал использовать совет Казанского. Через последовательное вычисление ошибка вообще не возникает - раз 50 пробовал разные варианты, удалял листы, переименовывал их, пересохранял файл - макрос срабатывает стабильно. Спасибо!
Но причина ошибки осталась загадкой, и еще более интригующей:)
Код
Sub OpenHTML()
fff = Application.GetOpenFilename("Все веб-страницы,*.html")
If fff = "False" Then Exit Sub
Application.DisplayAlerts = False
Workbooks.Open (fff)
ActiveWorkbook.Sheets(1).Name = "EGRN"
ActiveWorkbook.Sheets("EGRN").Move After:=ThisWorkbook.Sheets("Report")
Dim lLineNum As Long
Set x1 = ThisWorkbook.Sheets("EGRN")
Set x2 = ThisWorkbook.VBProject
Set x2 = x2.VBComponents()
x4 = x1.CodeName
With x2(x4).CodeModule
    lLineNum = .CreateEventProc("SelectionChange", "Worksheet")
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "Static previous_selection As String"
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "If previous_selection <> """" Then"
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "Range(previous_selection).Interior.ColorIndex = xlColorIndexNone"
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "End If"
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "Target.Interior.Color = vbYellow"
    lLineNum = lLineNum + 1
    .InsertLines lLineNum, "previous_selection = Target.Address"
End With
End Sub
Изменено: Leo Grig - 17 Сен 2018 14:15:11
 
Цитата
Leo Grig написал:
и еще более интригующей
это вряд ли. Перед строкой:
Код
Dim lLineNum As Long
поставьте DoEvents и попробуйте заново. Или еще вариант. Вместо строки:
Код
Set x1 = ThisWorkbook.Sheets("EGRN")
записать такую конструкцию:
Код
Dim x1 As Worksheet
On Error Resume Next
Do While x1 Is Nothing
Set x1 = ThisWorkbook.Sheets("EGRN")
DoEvents
Loop
On Error GoTo 0
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Дмитрий,
попробовал Ваш совет. Вставил DoEvents в первоначальный вариант кода - ошибка не исчезла.
Во втором варианте кода изменил строку Set x1 = ... на Вашу конструкцию - ошибки как не было, так и нет.  
Так в чем же было дело, что вызывало ошибку?
 
Цитата
Leo Grig написал:
что вызывало ошибку?
ошибку вызывало то, что сразу после копирования листа он был не доступен сразу - на копирование и его перенос нужно время, которого просто не всегда хватает. Цикл Do заставляет дождаться завершения копирования и определения листа в конечной книге.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Тогда получается, что во втором варианте кода вся эта очередь вычислений x1, x2, x3, x4 просто давала доп. время для завершения копирования, поэтому ошибка и не возникала:))
Дмитрий, коллеги, большое вам спасибо!!!
Страницы: 1
Читают тему (гостей: 1)
Наверх