Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ошибка про программном добавлении макроса в модуль нового листа
 
#1
17.09.2018 10:40:08

Добрый день!
У меня 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.09.2018 12:47:51
 
 
 
#2
17.09.2018 10:48:25
Я бы посововетовал не создавать каждый раз событие листа, а использовать событие из ЭтаКнига - Workbook_SheetSelectionChange. А там просто делать проверку на имя листа:
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.name = "OGRN" then
    'выполняем нужный код
    end if
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#3
17.09.2018 10:53:00
или копировать лист (копируется вместе с кодом) и работает по тем же правилам, что и оригинал
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#4
17.09.2018 11:30:37
Цитата
Ігор Гончаренко написал:
или копировать лист
Игорь, там лист и копируется, но он копируется из html файла, открытого в Excel, как я понял. И кода там точно нет.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
17.09.2018 11:51:24
Как выкрутиться, я в общем-то понимаю. Собирался использовать вариант, который предложил  Ігор Гончаренко - создать скрытый лист с макросом в модуле листа как образец, при необходимости дублировать лист и в него вставлять данные из html (вместо сохранения html как нового листа). Про вариант Workbook_SheetSelectionChange почему-то не подумал, спасибо, Дмитрий!
Но очень хочется понять, почему макрос ведет себя так странно - то срабатывает, то не срабатывает. Никак не удается стабилизировать ошибку.
 
 
 
#6
17.09.2018 12:11:21
Цитата
Leo Grig написал:
ошибка 9
Это Subscript out of range и возникает при обращении к несуществующему элементу коллекции. Либо Sheets, либо VBComponents. Попробуйте локализовать причину, вычисляя выражение поэтапно
Код
set x = ThisWorkbook.Sheets("EGRN")
set x = ThisWorkbook.VBProject.VBComponents(x.CodeName)
with x.CodeModule
 
 
 
#7
17.09.2018 14:14:24
Попробовал использовать совет Казанского. Через последовательное вычисление ошибка вообще не возникает - раз 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.09.2018 14:15:11
 
 
 
#8
17.09.2018 14:20:03
Цитата
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
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
17.09.2018 14:57:45
Дмитрий,
попробовал Ваш совет. Вставил DoEvents в первоначальный вариант кода - ошибка не исчезла.
Во втором варианте кода изменил строку Set x1 = ... на Вашу конструкцию - ошибки как не было, так и нет.  
Так в чем же было дело, что вызывало ошибку?
 
 
 
#10
17.09.2018 15:30:02
Цитата
Leo Grig написал:
что вызывало ошибку?
ошибку вызывало то, что сразу после копирования листа он был не доступен сразу - на копирование и его перенос нужно время, которого просто не всегда хватает. Цикл Do заставляет дождаться завершения копирования и определения листа в конечной книге.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#11
17.09.2018 15:41:27
Тогда получается, что во втором варианте кода вся эта очередь вычислений x1, x2, x3, x4 просто давала доп. время для завершения копирования, поэтому ошибка и не возникала:))
Дмитрий, коллеги, большое вам спасибо!!!
 
 
 
Страницы: 1
Наверх