Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Проверка для активной книги - "ThisWorkbook" или "ЭтаКнига", для русской версии используется ссылка на ЭтаКнига. Для английской ThisWorkbook
 
Есть макрос вставляющий в ThisWoorkbook/ЭтаКнига код событийной процедуры.  у меня это Workbook_AfterSave.

Код
Sub CreateEventProcedure()
'https://www.excel-vba.ru/chto-umeet-excel/kak-dobavit-kod-procedury-programmno-skopirovat-modul/
    Dim objVBProj As Object, objVBComp As Object, objCodeMod As Object
    Dim lLineNum As Long
    'добавляем новую книгу
    Workbooks.Add
    'получаем ссылку на проект и модуль книги
    Set objVBProj = ActiveWorkbook.VBProject
    Set objVBComp = objVBProj.VBComponents("ЭтаКнига")
    Set objCodeMod = objVBComp.CodeModule
    'вставляем код
    With objCodeMod
        lLineNum = .CreateEventProc("Open", "Workbook")
        lLineNum = lLineNum + 1
        .InsertLines lLineNum, "    MsgBox ""Hello World"""
    End With
End Sub


Есть нюанс: "для русской версии используется ссылка на ЭтаКнига. Для английской ThisWorkbook"

Код
Set objVBComp = objVBProj.VBComponents("ThisWorkbook")


??? КАК организовать проверку для активной книги - в ней ThisWorkbook или ЭтаКнига ???
Файлы все однотипные, но одни созданы на MSO2007 EN, а другие в MSO2010 RU...
 
application.LanguageSettings.LanguageID
По вопросам из тем форума, личку не читаю.
 
Боюсь, что надо будет поискать, поскольку пользователь может присвоить любое имя.
Код
' Возвращает объект проекта, относящийся к рабочей книге
Function GetWBComp(ByVal VBProj) As Object
  Dim comp As Object, v
  
  On Error Resume Next
  For Each comp In VBProj.VBComponents
     If comp.Type = 100 Then ' vbext_ct_Document
       Err.Clear
       v = comp.Properties.Item("IsAddin")
       If Err.Number = 0 Then
         Set GetWBComp = comp
         Exit For
       End If
     End If
  Next comp
  
  On Error GoTo 0
End Function
В #1 строку 9 замените на:
Код
Set objVBComp = GetWBComp(objVBProj)
Владимир
 
Цитата
БМВ написал:
application.LanguageSettings.LanguageID
Это же идентификатор языка приложения. Русской версией Офиса я открываю книгу в которой фигурирует ThisWorkbook...

Вот эта часть выдаёт ошибку:
Код
    Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)
            Case 1033: Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook")
            Case 1049: Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
            Case Else: Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook")
    End Select
 
jack_21,  Да, ответил не на вопрос. смотрите #3
По вопросам из тем форума, личку не читаю.
 
Всем - привет. Можно проще: Set objVBComp = objVBProj.VBComponents(ActiveWorkbook.CodeName)
Изменено: ZVI - 18 авг 2019 02:01:48
 
Здравствуйте, Владимир, спасибо!  :)  
Владимир
 
Спасибо за решения! Вариант от ZVI наиболее подошёл, ибо без функции...
Спасибо!

upd: продолжаю пробовать оба варианта - что-то идёт не так...

upd2: всё заработало - с решением от ZVI :
Код
Set objVBComp = objVBProj.VBComponents(ActiveWorkbook.CodeName)
Изменено: jack_21 - 18 авг 2019 16:50:41
Страницы: 1
Читают тему (гостей: 1)
Наверх