Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | VBE & Module


Rambler's Top100


Counter CO.KZ


Предисловие : Все приведённые примеры неактуальны для MS Excel 95, т.к. в этой версии нет многих об'ектов, в т.ч. и редактора VBA. В MS Excel XP, перед выполнением приведённых примеров, необходимо предварительно в меню Сервис выбрать пункт Макросы и команду Безопасность. Затем выделить закладку Надёжные источники и установить "флажок" Доверять доступ к Visual Basic Project. В противном случае, при попытке доступа к VBProject, Вы получите ошибку.



    [1] [2]

  1. Как добавить комментарии в макрос ? 2004
  2. Как закомментировать/раскомментировать целый блок ? 21.03.2007
  3. Как проверить защищён(заблокирован) или нет VBProject ? 04.11.2008
  4. Как изменить имя VBProject стандартными средствами и с помощью VBA ? 08.03.2009
  5. Как изменить имя модуля (других компонентов) стандартными средствами и VBA ? 2004
  6. Как удалить текст макроса средствами VBA ? 20.05.2005
  7. Как удалить макрос средствами VBA ? 07.10.2007
  8. Как удалить модуль, модуль класса, UserForm средствами VBA ? 30.05.2005
  9. Как удалить все стандартные модули, модули класса, UserForm, а также удалить программный код из всех модулей листа, книги ? 06.01.2008
  10. Как удалить все пользовательские формы UserForm ? NEW 03.09.2016
  11. Как закомментировать весь макрос средствами VBA ? 01.04.2011
  12. Как добавить одну или несколько строк в нужное место программы ? 29.07.2007
  13. Как заменить определённую строку программы на другую ? 29.07.2007
  14. Как удалить одну или несколько строк программы ? 29.07.2007
  15. Как определить общее количество строк в модуле ? 07.10.2007
  16. Как определить количество строк раздела описаний модуля ? 07.10.2007
  17. Как найти нужный текст во всех модулях книги ?
    Как определить наличие определённого текста в модуле(ях) ?
    15.09.2007
  18. Как заменить текст во всех модулях книги ? 09.04.2015
  19. Как получить список (имя книги, проекта, модуля, процедуры) всех Sub макросов, находящихся в открытых рабочих книгах ? 04.11.2008
  20. Как получить список всех процедур (Sub, Function) нужной рабочей книги ? 19.07.2010
  21. Как программно создать UserForm, изменить значения нужных свойств, а затем отобразить созданную форму ? 16.06.2007
  22. Как экспортировать все стандартные модули из текущей книги во вновь созданную рабочую книгу ? 30.06.2007
  23. Как экспортировать все модули текущей книги ? 03.07.2007
  24. Как в редакторе VBA создать кнопку, а также макрос, позволяющий сохранить все модули (имя модуля + дата и время сохранения) активного VBProject'а ? 09.05.2011
  25. Как определить/изменить имя рабочего листа, используемое в среде VBA ? 05.05.2005
  26. Как получить доступ к рабочему листу (и листу диаграммы) не используя его индекс или имя ? 18.04.2010
  27. Как получить доступ к рабочему листу, ячейкам, с помощью кодового имени в виде переменной ? 18.04.2010
  28. Как при создании нового рабочего листа синхронизировать имена этого листа ? 10.03.2007
  29. Как определить наличие программного текста в модуле ? 16.07.2006
  30. Как получить программный текст нужного модуля ? 11.03.2009
  31. Как осуществить просмотр программного кода нужного макроса ? 28.06.2007
  32. Как осуществить просмотр кода нужного макроса, т.е. программно открыть необходимый макрос в редакторе VBA ? 25.03.2012
  33. Как программно перейти в редактор VBA ? 03.03.2011
  34. Как программно подключить нужную библиотеку ?
    Как программно добавить ссылку на библиотеку ?
    11.02.2007
  35. Как программно удалить все "битые" ссылки ? 18.03.2011
  36. Как отследить подключение и отключение ссылок ? 07.10.2007
  37. Как запретить подключение и отключение ссылок вручную ? 09.05.2008
    [1] [2]


  • Ответ :
  • If ActiveWorkbook.VBProject.Protection = 1 Then 'vbext_pp_locked
       MsgBox "VBProject защищён", , ""
    Else
       MsgBox "VBProject не защищён", , ""
    End If
    Примечание : активная рабочая книга выбрана только в качестве примера.
  • Ответ :

    Вариант I. (вручную)

    Нажмите ALT + F11 (редактор макросов)
    На экране слева Вы должны увидеть VBAProject(имя_вашего_файла.xls)
    (при условии, что данное имя никто ранее не менял)
    Если этого не видно, то в меню Вид (View) выберите Окно проекта (Project Explorer)
    Далее нужно выбрать свой проект, для этого достаточно просто кликнуть по нему мышкой. Затем выберите один из наиболее подходящих вариантов :
    1. В меню Вид (View) выберите Окно свойств (Properties Window) или просто нажмите F4.
    Hапротив поля (Name) и будет находиться нужное нам имя проекта, которое мы и можем изменить вручную.
    2. Кликните правой кнопкой мышки и в появившемся контекстном меню выберите команду Свойства VBAProject (VBAProject Properties...), затем в стандартном диалоговом окне выделите закладку Общие (General), в поле Имя проекта: (Project Name) введите нужное имя и нажмите кнопку OK.
    3. В меню Сервис (Tools) выберите команду Свойства VBAProject (VBAProject Properties...), после чего в диалоговом окне выделите закладку Общие (General), в поле Имя проекта: (Project Name) введите нужное имя и нажмите кнопку OK.

    Вариант II. (программно)

    Пример переименования активного проекта
  • Application.VBE.ActiveVBProject.Name = "VBAProject_New"
    Пример переименования проекта с использованием его индекса(номера)
    Application.VBE.VBProjects(3).Name = "VBAProject_New"
    Комментарий : При отсутствии проекта с указанным индексом возникнет ошибка

    Пример переименования проекта с именем "VBAProject"
    Application.VBE.VBProjects("VBAProject").Name = "VBAProject_New"
    Комментарий :
  • При отсутствии проекта с указанным именем также возникнет ошибка
  • При наличии нескольких проектов с таким именем будет переименован проект, имеющий минимальный индекс(номер)

    Пример переименования проекта активной и текущей рабочей книги
  • ActiveWorkbook.VBProject.Name = "VBAProject_New"

    ThisWorkbook.VBProject.Name = "VBAProject_New"
    Пример переименования проекта конкретной рабочей книги
    Workbooks("Personal.xls").VBProject.Name = "VBAProject_New"
    Комментарий :
  • Необходимая рабочая книга, естественно, должна быть открыта
  • Вместо имени рабочей книги можно использовать её индекс(номер)
  • Ответ :

    Вариант I. (вручную)

    Нажмите ALT + F11 (редактор макросов)
    На экране слева Вы должны увидеть VBAProject(имя_вашего_файла.xls)
    (при условии, что данное имя никто не менял)
    Если этого не видно, то в меню Вид (View) выберите Окно проекта (Project Explorer)
    Далее нужно выбрать нужный компонент, для этого достаточно кликнуть по нему мышкой. Затем в меню Вид (View) выбрать Окно свойств (Properties Window) или просто нажать F4.
    Hапротив поля (Name) и будет находиться нужное нам имя компонента, которое мы и можем изменить вручную.

    Вариант II. (программно)
  • Application.VBE.ActiveVBProject.VBComponents(4).Name = "Module"

    Application.VBE.ActiveVBProject.VBComponents("Module").Name = "New"
    Вариант II (б)
    ActiveWorkbook.VBProject.VBComponents(4).Name = "Module"

    ActiveWorkbook.VBProject.VBComponents("Module").Name = "New"

  • Ответ :

    Вариант I. (без переменных)
  • With Application.VBE.SelectedVBComponent
         If .CodeModule.CountOfLines <> 0 Then
            .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
         End If
    End With ' (а)
    With ActiveWorkbook.VBProject.VBE.SelectedVBComponent
         If .CodeModule.CountOfLines <> 0 Then
            .CodeModule.DeleteLines 1, .CodeModule.CountOfLines
         End If
    End With ' (б)
    Вариант II. (с переменными)
    Set VBComponent = Application.VBE.SelectedVBComponent

    iCountOfLines = VBComponent.CodeModule.CountOfLines

    If iCountOfLines <> 0 Then
       VBComponent.CodeModule.DeleteLines 1, iCountOfLines
    End If
    Внимание :
  • - Компонент SelectedVBComponent выбран только в качестве примера
  • - Число обращений к об'екту CodeModule увеличено только для удобства "прочтения" кода
  • Ответ : Скачать пример

    Для того, чтобы удалить текст макроса можно воспользоваться предыдущим советом, подобным же образом можно удалить и сам макрос. Однако, для этого требуется указать имя или индекс(номер) модуля, который содержит ненужный макрос, а также номер строки с которой начинается программный код и общее количество строк удаляемого кода. Если имя/номер модуля заранее известно и в этом модуле находится всего один макрос, то трудностей, как правило не возникает, если неизвестно, то осуществить задуманное можно, например, так : (VBProject не должен быть защищён)
  • Private Sub DeleteProcedure()
        iProcedure$ = InputBox(Prompt:="Введите имя макроса," & _
        vbCrLf & "который требуется удалить", Title:="")
        If iProcedure$ = "" Then _
        MsgBox "Вы не указали имя ненужного макроса", , "": Exit Sub
        For Each iVBComponent In ActiveWorkbook.VBProject.VBComponents
            With iVBComponent.CodeModule
                 If .Find("Sub " & _
                    iProcedure$, 1, 1, .CountOfLines, 1) = True Then
                    iStartLine& = .ProcStartLine(iProcedure$, 0)
                    iCountLines& = .ProcCountLines(iProcedure$, 0)
                    .DeleteLines iStartLine&, iCountLines& : Exit For
                 End If
            End With
        Next
    End Sub

  • Ответ :
  • With ActiveWorkbook.VBProject.VBComponents
         If .Item(5).Type Like "[1-3]" Then
            .Remove .Item(5)
         End If
    End With ' (а)
    With Application.VBE.ActiveVBProject.VBComponents
         If .Item(5).Type Like "[1-3]" Then
            .Remove .Item(5)
         End If
    End With ' (б)
    Внимание :
  • - .Item(5) выбран только в качестве примера, поэтому существует вероятность, что в Вашем случае это будет модуль листа или количество компонентов в семействе будет меньше указанного.
  • - вместо инструкции With Вы можете использовать инструкцию Set [См. выше]
  • Ответ :

    Для того, чтобы удалить из текущей рабочей книги : все стандартные модули, модули класса, UserForm, а также программный код из всех модулей листа, книги, достаточно использовать любой из нижеопубликованных примеров (VBProject не должен быть защищён)
  • Private Sub DeleteModulesAndCode()
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            With iVBComponent
                 Select Case .Type
                     Case 1 To 3: .Collection.Remove iVBComponent
                     Case 100: .CodeModule.DeleteLines _
                     1, .CodeModule.CountOfLines
                 End Select
            End With
        Next
    End Sub
    Private Sub DeleteModulesAndCode2()
        Set iVBComponents = ThisWorkbook.VBProject.VBComponents
        For Each iVBComponent In iVBComponents
            Select Case iVBComponent.Type
                Case 1 To 3: iVBComponents.Remove iVBComponent
                Case 100
                With iVBComponent.CodeModule
                     .DeleteLines 1, .CountOfLines
                End With
            End Select
        Next
    End Sub
    Private Sub DeleteModulesAndCode3()
        With ThisWorkbook.VBProject.VBComponents
             For iCount& = .Count To 1 Step -1
                 Set iVBComponent = .Item(iCount&)
                 Select Case iVBComponent.Type
                     Case 1 To 3: .Remove iVBComponent
                     Case 100
                     iVBComponent.CodeModule.DeleteLines _
                     1, iVBComponent.CodeModule.CountOfLines
                 End Select
            Next
        End With
    End Sub

  • Ответ :

    Для того, чтобы удалить из текущей рабочей книги все пользовательские формы UserForm, достаточно использовать любой из нижеопубликованных примеров (VBProject не должен быть защищён)
  • Private Sub DeleteOnlyUserForms()
        With ThisWorkbook.VBProject.VBComponents
             For iCount& = .Count To 1 Step -1
                 If .Item(iCount&).Type = 3 Then .Remove .Item(iCount&)
             Next
        End With
    End Sub
    Private Sub DeleteOnlyUserForms2()
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            If iVBComponent.Type = 3 Then _
            iVBComponent.Collection.Remove iVBComponent
        Next
    End Sub
    Private Sub DeleteOnlyUserForms2v2()
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            If iVBComponent.Type = 3 Then _
            ThisWorkbook.VBProject.VBComponents.Remove iVBComponent
        Next
    End Sub
    Private Sub DeleteOnlyUserForms2v3()
        Set iVBComponents = ThisWorkbook.VBProject.VBComponents
        For Each iVBComponent In iVBComponents
            If iVBComponent.Type = 3 Then iVBComponents.Remove iVBComponent
        Next
    End Sub

  • Ответ :

    Для того, чтобы добавить одну строку в начало программы, находящейся в модуле с индексом(номером) один в активной рабочей книге, достаточно использовать следующий пример :
  • ActiveWorkbook.VBProject.VBComponents(1).CodeModule.InsertLines 1, "Option Explicit"
    Для того, чтобы добавить несколько строк в тот же модуль, но уже начиная с пятой строки, достаточно использовать :
    ActiveWorkbook.VBProject.VBComponents(1).CodeModule.InsertLines 5, _
    "Dim iText as String, iColumn As Integer" & vbNewLine & _
    "iText = ""Microsoft Excel""" & vbNewLine & _
    "iColumn = [Имя_ячейки].Column"

  • Ответ :

    Для того, чтобы заменить одну строку программы на другую, достаточно использовать следующий пример :
  • ActiveWorkbook.VBProject.VBComponents(1).CodeModule.ReplaceLine 1, "Private Sub Workbook_Activate()"
    В данном примере предполагается, что замена будет осуществляться в модуле с индексом(номером) один активной рабочей книги, где первая строка, которая и подлежит замене, содержит имя события, например, Private Sub Workbook_Open()
  • Ответ :

    Для того, чтобы удалить первую строку программы, которая находится в первом модуле активной рабочей книги, достаточно использовать следующий пример :
  • ActiveWorkbook.VBProject.VBComponents(1).CodeModule.DeleteLines 1 'ActiveWorkbook.VBProject.VBComponents(1).CodeModule.DeleteLines 1, 1
    Для того, чтобы начиная с третьей строки, удалить десять строк той же программы, можно использовать :
    ActiveWorkbook.VBProject.VBComponents(1).CodeModule.DeleteLines 3, 10

  • Ответ : Скачать пример

    Для того, чтобы определить общее количество строк (включая пустые) в нужном модуле активной рабочей книги, можно использовать свойство CountOfLines об'екта CodeModule
  • iCountOfLines = ActiveWorkbook.VBProject.VBComponents(1).CodeModule.CountOfLines

  • Ответ : Скачать пример

    Для того, чтобы определить количество строк (включая пустые), находящихся в разделе описаний нужного модуля активной рабочей книги, можно использовать свойство CountOfDeclarationLines об'екта CodeModule
  • iCountOfDeclareLines = ActiveWorkbook.VBProject.VBComponents(1).CodeModule.CountOfDeclarationLines

  • Ответ :

    Для поиска нужного текста во всех модулях текущей рабочей книги, достаточно использовать следующий пример :
  • Private Sub SearchTextInModules()
        iText$ = "Private Sub"
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            With iVBComponent.CodeModule
                 If .Find(iText$, 1, 1, .CountOfLines, 1) = True Then _
                 MsgBox "Модуль " & iVBComponent.Name & " содержит искомый текст", , ""
            End With
        Next
    End Sub

  • Ответ :

    Для поиска и замены текста (без построчного чтения) во всех модулях открытой рабочей книги, можно использовать следующий пример, разумеется, указав свой текст.

    На всякий случай, уточню, что мы меняем Private на Public и регистр значения не имеет.
  • Private Sub ReplaceTextInModulesV2()
        For Each iVBComponent In Workbooks("Другая_книга.xls").VBProject.VBComponents
            With iVBComponent.CodeModule
                 iRow& = 1
                 Do While .Find("Private", iRow&, 1, .CountOfLines, 1) 'Do Until Not
                    .ReplaceLine iRow&, Replace(.Lines(iRow&, 1), "Private", "Public", , , vbTextCompare)
                 Loop
            End With
        Next
    End Sub
    Если же замену необходимо осуществить в текущей книге, т.е. в книге, где располагается сам макрос ReplaceTextInModules, но при этом нужно избежать изменения текста макроса, то можно просто расположить этот макрос в отдельном модуле и исключить этот модуль при переборе. Или же сделать так, чтобы искомого текста не было в макросе, например, заменив любой символ на его код (смотрите далее)
    Private Sub ReplaceTextInModules()
        Dim iVBComponent As Object, iRow&, iText$, iNewText$
        iText = Chr(80) & "rivate": iNewText = "Public"
        
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            With iVBComponent.CodeModule
                 iRow = 1
                 Do While .Find(iText, iRow, 1, .CountOfLines, 1) 'Do Until Not
                    .ReplaceLine iRow, _
                    Replace(.Lines(iRow, 1), iText, iNewText, , , vbTextCompare)
                 Loop
            End With
        Next
    End Sub
    Вариант II. Здесь мы также меняем Private на Public, однако, замена будет осуществляться уже с учётом регистра (что, разумеется, не является обязательным условием)
    Public Sub ReplaceTextInModulesV3()
        Dim iVBComponent As Object, iCount&, iCode$, iText$, iNewText$
        iText = Chr(80) & "rivate": iNewText = "Public"
        
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            With iVBComponent.CodeModule
                 iCount = .CountOfLines
                 If iCount > 0 Then
                    iCode = Replace(.Lines(1, iCount), iText, iNewText)
                    .DeleteLines 1, iCount: .InsertLines 1, iCode
                 End If
            End With
        Next
    End Sub
    Примечание : В Microsoft Excel 97 вместо Replace(...) следует использовать Application.Substitute(.Lines(iRow&, 1), "Private", "Public")
  • Ответ : Скачать пример

    Для того, чтобы создать "отчёт" о Sub процедурах, находящихся во всех открытых рабочих книгах, достаточно использовать следующий пример (если VBProject окажется защищён/заблокирован, то макросы этой книги - в списке будут отсутствовать)
  • Private Sub FindSubMacros()
        Application.ScreenUpdating = False
        Workbooks.Add xlWBATWorksheet: iRow& = 1
        Dim iWorkbook  As Workbook
        Dim iVBProject   As Object
        Dim iVBComponent As Object
        For Each iWorkbook In Workbooks
            Set iVBProject = iWorkbook.VBProject
            If Not iVBProject.Protection = 1 Then 'vbext_pp_locked
               For Each iVBComponent In iVBProject.VBComponents
                   iStart& = 1
                   With iVBComponent.CodeModule
                        Do Until Not .Find("Sub ", iStart&, 1, .CountOfLines, 1, , True)
                           iStart& = iStart& + 1: iRow& = iRow& + 1
                           Cells(iRow&, 1).Value = iWorkbook.Name
                           Cells(iRow&, 2).Value = iVBProject.Name
                           Cells(iRow&, 3).Value = iVBComponent.Name
                           Cells(iRow&, 4).Value = .ProcOfLine(iStart&, 0)
                        Loop
                   End With
               Next
            Else
               iRow& = iRow& + 1
               Cells(iRow&, 1).Value = iWorkbook.Name
               Cells(iRow&, 2).Value = iVBProject.Name & " (заблокирован)"
            End If
        Next
        With Cells(1, 1).Resize(1, 4) 'Range("A1:D1")
             .Value = Array("Workbook", "VBProject", "Module", "Sub_Macros")
             .Interior.Color = vbBlack
             .Font.Color = vbWhite
             .Font.Bold = True
             .EntireColumn.AutoFit
        End With
        Application.ScreenUpdating = True
    End Sub

  • Ответ : Скачать пример

    Для того, чтобы получить "список" всех Sub, Function процедур, находящихся в нужной рабочей книге (естественно, это не обязательно будет ThisWorkbook, однако она должна быть открытой), можно использовать нижеопубликованный пример (если VBProject окажется защищён/заблокирован, то макросы этой книги окажутся недоступными)

    Обратите внимание на то, что в примере используется элемент управления TreeView
  • Private Sub VBProjectTreeView()
        With ThisWorkbook.VBProject
             If .Protection = 1 Then Exit Sub 'vbext_pp_locked
             For Each iVBComponent In .VBComponents
                 'iModule = iVBComponent.Name
                 With iVBComponent.CodeModule
                      iModule$ = .Parent.Name
                      TreeView1.Nodes.Add , , iModule$, iModule$
                      For iCount& = 1 To .CountOfLines
                          iProcedure$ = .ProcOfLine(iCount&, 0) 'vbext_pk_Proc
                          If iProcedure$ <> "" Then
                             TreeView1.Nodes.Add iModule$, 4, , iProcedure$
                             iCount& = iCount& + .ProcCountLines(iProcedure$, 0)
                          End If
                      Next
                 End With
             Next
        End With
    End Sub

  • Ответ :

    Осуществить экспорт всех стандартных модулей из текущей книги, во вновь созданную рабочую книгу, можно так : (VBProject не должен быть защищён)
  • Private Sub ExportAllStdModules()
    With Application
         .ScreenUpdating = False
         iTempPath$ = .DefaultFilePath & .PathSeparator
         With .Workbooks.Add(xlWBATWorksheet).VBProject.VBComponents
              For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
                  If iVBComponent.Type = 1 Then
                     iModuleName$ = iTempPath$ & iVBComponent.Name
                     iVBComponent.Export FileName:=iModuleName$
                     .Import FileName:=iModuleName$
                     Kill PathName:=iModuleName$
                  End If
              Next
         End With
         .ScreenUpdating = True
    End With
    End Sub

  • Ответ :

    Осуществить экспорт всех модулей из текущей книги, в указанную папку, в виде соответствующих файлов, можно так : (VBProject не должен быть защищён)
  • Private Sub ExportAllVBComponents()
        iTempPath$ = Environ("Temp") & "\" 'укажите свою папку
        For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
            Select Case iVBComponent.Type
                Case 1: iType$ = ".bas"
                Case 3: iType$ = ".frm"
                Case 2, 100: iType$ = ".cls"
            End Select
            iVBComponent.Export _
            FileName:=iTempPath$ & iVBComponent.Name & iType$
        Next
    End Sub

  • Ответ :

    Определить имя рабочего листа, используемого в среде VBA и именуемое как кодовое или программное имя, можно так :
  • iCodeName = Worksheets(1).CodeName
    Несмотря на то, что свойство CodeName доступно только для чтения, программное имя рабочего листа можно изменять, если не забывать, что модуль входит в семейство VBComponents.
    iCodeName = ActiveSheet.CodeName

    ActiveWorkbook.VBProject.VBComponents(iCodeName).Name = "CodeName" ' Вариант I(а).

    Application.VBE.ActiveVBProject.VBComponents(iCodeName).Name = "CodeName" ' Вариант I(б).
    Вариант II. Кроме этого, у рабочего листа обнаружилось скрытое свойство _CodeName , которое доступно не только для чтения, но и для записи.
    Dim iList As Worksheet
    Set iList = Worksheets(1) 'ActiveSheet

    iList.[_CodeName] = "CodeName"

  • Ответ : Скачать пример

    Получить доступ к рабочему листу (или листу диаграммы) можно не только с помощью индекса(номера) или имени в семействе Worksheets или Sheets, (Charts), но и посредством использования имени, используемого в среде VBA, и именуемого кодовое имя (иногда называемого также программное имя) [см. выше]
  • Dim iWorksheet As Worksheet
    Set iWorksheet = Лист2
    With Лист2

    End With
    Пример использования кодового имени (ввод стандартной функции рабочего листа в несмежные ячейки и изменение цвета заливки пустых ячеек)
    Лист2.[A1:C3].Clear

    Лист2.[A1,A3,B2,C1,C3].Formula = "=Rand()"

    Лист2.[A1:C3].SpecialCells(xlBlanks).Interior.Color = vbRed
    With Лист2
         .[A1:C3].Clear
         .[A1,A3,B2,C1,C3].Formula = "=Rand()"
         .[A1:C3].SpecialCells(xlBlanks).Interior.ColorIndex = 3
    End With
    Комментарий :
  • - Если применение кодового имени предполагается только из-за возможности случайного переименования, перемещения рабочего листа, то Вы можете запретить подобные действия [FAQ]
  • - Кодовое имя также можно изменить, причём как вручную [FAQ32], так и программно [FAQ45]
  • - Не забывайте, что это имя также имеет свои ограничения [см. ниже]
  • - Использование кодового имени возможно только для текущей книги, для того, чтобы получить доступ к листу другой рабочей книги необходимо либо установить ссылку , либо воспользоваться следующим [FAQ533]
  • Ответ : Скачать пример

    Если Вы предпочитаете использовать кодовое (программное) имя рабочего листа, диаграммы [FAQ532], [FAQ45], то, скорее всего, уже заметили, что это имя приходится указываться в виде константы, если же это неприемлемо, и Вам необходимо получить доступ к рабочему листу и его ячейкам, но при этом кодовое имя должно быть переменным, то решить поставленную задачу можно, как минимум, двумя способами :

    Вариант I.
  • Dim iVBComponent As Object
    Dim iDiapazon As Range, iWorksheet As Worksheet

    iCodeName$ = "Лист2"

    Set iVBComponent = ThisWorkbook.VBProject.VBComponents(iCodeName$)
    Set iDiapazon = iVBComponent.Properties("Cells").Object
    Set iWorksheet = iDiapazon.Worksheet '.Parent
    Вариант II.
    Dim iVBComponent As Object
    Dim iDiapazon As Range, iWorksheet As Worksheet

    iCodeName$ = "Лист2"

    Set iVBComponent = ThisWorkbook.VBProject.VBComponents(iCodeName$)
    Set iWorksheet = ThisWorkbook.Worksheets(iVBComponent.Properties("Name").Value)
    Set iDiapazon = iWorksheet.Cells
    Комментарий :
  • В текущей рабочей книге обязательно должен присутствовать рабочий лист, с указанным кодовым именем, в противном случае возникнет ошибка
  • Доступ к другим открытым рабочим книгам можно получить, если использовать индекс(номер) или имя нужной книги в семействе Workbooks, например, Workbooks(1).Worksheets или Workbooks("Personal.xls").VBProject

    Если же Вы не уверены в наличии листа с указанным именем или не имеете доверенного доступа к Visual Basic Project, который необходим для решения поставленной задачи вышеопубликованным способом, то получить доступ можно также с помощью нижеприведённой функции. Которая имеет всего два обязательных аргумента, первый это, собственно, кодовое имя (регистр не важен), а второе, это одно (из двух семейств) в котором будет производиться поиск листа, т.е. если нам необходимо найти рабочий лист, то это Worksheets, если же ищем лист диаграммы, то Charts.
  • Public Function getSheetWithCodeName(CodeName$, SourceNames As Object) As Object
        Dim iList As Object
        For Each iList In SourceNames
            If StrComp(iList.CodeName, CodeName, vbTextCompare) = 0 Then
               Set getSheetWithCodeName = iList
               Exit Function
            End If
        Next
    End Function

  • Ответ :
  • Private Sub Add_And_SynchronizeName()
        iNewName$ = "Archive" 'укажите своё имя листа
        With ThisWorkbook
             If Not .ProtectStructure Then
                .Worksheets.Add.Name = iNewName$
                With .VBProject.VBComponents
                     .Item(.Count).Name = iNewName$
                End With
             Else
                MsgBox "В рабочей книге : " & .Name & vbCrLf & _
                "невозможно создание нового листа", vbCritical, ""
             End If
        End With
    End Sub
    Private Sub Add_And_SynchronizeName2()
        iNewName$ = "Archive2" 'укажите своё имя листа
        With ThisWorkbook
             If Not .ProtectStructure Then
                Dim iWorksheet As Worksheet
                Set iWorksheet = .Worksheets.Add
                iWorksheet.Name = iNewName$

                Dim iVBComponents As Object
                Set iVBComponents = .VBProject.VBComponents
                iVBComponents(iWorksheet.CodeName).Name = iNewName$
             Else
                MsgBox "В рабочей книге : " & .Name & vbCrLf & _
                "невозможно создание нового листа", vbCritical, ""
             End If
        End With
    End Sub
    Комментарий : Для создания общего имени необходимо учитывать особенности каждого имени, т.к. у каждого имени существуют свои ограничения :

    Имя (Name) :
  • - Имя нового рабочего листа не должно совпадать с именами уже имеющихся листов (Sheets)
  • - Имя листа не должно содержать более 31 символа.
  • - Имя листа не должно содержать следующих символов / \ ? : *
    кроме того, существует ограничение на порядок ввода [ ]

    Кодовое(программное) имя (CodeName) :
  • - Кодовое имя нового рабочего листа не должно совпадать с кодовыми именами уже имеющихся рабочих листов и листов диаграмм (Worksheets & Charts)
  • - Кодовое имя рабочего листа не должно содержать более 31 символа.
  • - Первый символ в имени должен быть только буквой (кодовое имя не может начинаться с числовых значений или символа подчёркивания)
  • - Кодовое имя может содержать только буквы, числовые значения и символ подчёркивания (и не может содержать только числа и/или символ подчёркивания см. пункт 3)
  • Ответ :

    Пример поиска во всех программных модулях текущей рабочей книги (VBProject не должен быть защищён) Для определения наличия текста в определённом модуле, используйте его индекс(номер) или имя.
  • Workbooks.Add xlWBATWorksheet

    For Each iVBComponent In ThisWorkbook.VBProject.VBComponents
        iCountOfLines = iVBComponent.CodeModule.CountOfLines
        If iCountOfLines > 0 Then
           iText = Application.Clean(Left( _
           iVBComponent.CodeModule.Lines(1, iCountOfLines), 32767))
           If iText <> "" And iText <> "Option Explicit" Then
              iCounter = iCounter + 1
              Cells(iCounter, 1).Value = iVBComponent.Name
           End If
        End If
    Next

  • Ответ : Скачать пример

    Пример получения программного кода определённого модуля текущей рабочей книги (VBProject не должен быть защищён)
  • Private Sub GetTextCodeModule()
        iModule = "Модуль1" ' iModule = 5
        With ThisWorkbook.VBProject.VBComponents(iModule).CodeModule
             If .CountOfLines = 0 Then
                MsgBox "Модуль " & iModule & " не содержит кода", , ""
             Else
                iText$ = .Lines(1, .CountOfLines)
                MsgBox iText$, , ""
                
                iCleanText$ = _
                Application.Clean(Left(.Lines(1, .CountOfLines), 32767))
                If iCleanText$ <> "" And iCleanText$ <> "Option Explicit" _
                Then MsgBox iText$, , ""
             End If
        End With
    End Sub

  • Ответ :

    Для того, чтобы осуществить просмотр кода определённого макроса, проще говоря, открыть необходимый макрос в редакторе Visual Basic, причём без использования VBA, можно использовать этот [FAQ283] Однако, если это необходимо проделать программно, то решить поставленную задачу можно, с помощью одного из нижеопубликованных вариантов :

    Вариант I.
  • Application.Goto Reference:="Модуль1.Тест"
    Вариант II.
    ActiveWorkbook.FollowHyperlink "#Модуль1.Тест"
    Вариант II(б).
    ActiveWorkbook.FollowHyperlink ActiveWorkbook.FullName, "Модуль1.Тест"
    
    With ActiveWorkbook
         .FollowHyperlink .FullName, "Модуль1.Тест"
    End With
    В данных примерах предполагается, что в активной рабочей книге, в модуле "Модуль1" находится макрос с именем "Тест"

    Комментарий : Если макрос расположен в стандартном модуле и имя Вашего макроса "уникально", т.е. другие модули не содержат макроса с аналогичным именем, то имя модуля можно не указывать.
  • Ответ :

    Для того, чтобы 'открыть' окно редактора VBA, можно воспользоваться следующей инструкцией :
  • Application.VBE.MainWindow.Visible = True
    А если необходимо ещё и развернуть окно, то :
    Application.VBE.MainWindow.WindowState = 2 'vbext_ws_Maximize

  • Ответ :

    Пример подключения Microsoft Scripting Runtime (FSO, Dictionary, Encoder) для версий :
  • Win 98, Me - строка [1]
  • Win 2000, XP - строка [2]
  • Option Compare Text

    Private Sub VBProject_AddReference()

    iPath$ = Environ("WinDir")
    iFileName$ = iPath$ & "\System\Scrrun.dll" '[1] Win 98, Me
    'iFileName$ = iPath$ & "\System32\Scrrun.dll" '[2] Win 2000, XP

    If Dir(iFileName$) <> "" Then
       With ThisWorkbook.VBProject.References
            For iCount% = 1 To .Count
                If .Item(iCount%).FullPath = iFileName$ Then
                   MsgBox "Эта библиотека уже подключена", , ""
                   Exit Sub
                End If
            Next
            .AddFromFile FileName:=iFileName$
       End With
    Else
       MsgBox "Отсутствует нужный файл", , ""
    End If

    End Sub
    Private Sub VBProject_AddReference2()

    iFileName$ = Environ("WinDir") & "\System\Scrrun.dll" '[1] Win 98, Me
    'iFileName$ = Environ("WinDir") & "\System32\Scrrun.dll" '[2] Win 2000, XP

    If Dir(iFileName$) <> "" Then
       Dim iReference As Object, iReferences As Object ' Variant
       'Dim iReference As VBIDE.Reference, iReferences As VBIDE.References
       'Если подключена библиотека :
       'Microsoft Visual Basic for Applications Extensibility x.x
       Set iReferences = ThisWorkbook.VBProject.References
       For Each iReference In iReferences
           If StrComp(iReference.FullPath, iFileName$, vbTextCompare) = 0 Then
              MsgBox "Эта библиотека уже подключена", , ""
              Exit Sub
           End If
       Next
       iReferences.AddFromFile FileName:=iFileName$
    Else
       MsgBox "Отсутствует нужный файл", , ""
    End If

    End Sub

  • Ответ : Актуально для MS Excel 97

    Для того, чтобы удалить все недействительные ссылки, т.е. те, что в списке доступных ссылок, начинаются как ОТСУТСТВУЕТ: (Excel 97 Rus) или MISSING: (Excel 97 Eng), можно использовать любой из нижеопубликованных вариантов :
  • Private Sub VBProject_RemoveMissingRef()
        Dim iCount% ' iCount As Integer
        With ThisWorkbook.VBProject.References
             For iCount = .Count To 1 Step -1
                 If .Item(iCount).IsBroken = _
                 True Then .Remove .Item(iCount)
             Next
        End With
    End Sub
    Private Sub VBProject_RemoveMissingRef2()
        Dim iReferences As Object, iReference As Object ' Variant
        'Dim iReferences As VBIDE.Reference, iReference As VBIDE.References
        'Если подключена библиотека :
        'Microsoft Visual Basic for Applications Extensibility x.x
        Set iReferences = ThisWorkbook.VBProject.References
        For Each iReference In iReferences
            If iReference.IsBroken = True _
            Then iReferences.Remove iReference
        Next
    End Sub

  • Ответ :

    Для того, что при работе с нужной рабочей книгой, Вы могли "контролировать" программное добавление и удаление ссылок, достаточно скопировать нижеопубликованный код в модуль ThisWorkbook(ЭтаКнига) этой книги и использовать два нижеприведённых события об'екта ReferencesEvents.
  • Private WithEvents iRefEvents As VBIDE.ReferencesEvents
    'Следующая библиотека обязательно должна быть подключена
    'Microsoft Visual Basic for Applications Extensibility x.x

    Private Sub Workbook_Open()
        Set iRefEvents = _
        Application.VBE.Events.ReferencesEvents(Me.VBProject)
    End Sub

    Private Sub iRefEvents_ItemAdded(ByVal Reference As VBIDE.Reference)
        MsgBox "Добавлена ссылка : " & Reference.Name & _
        vbCrLf & Reference.FullPath, , ""
    End Sub

    Private Sub iRefEvents_ItemRemoved(ByVal Reference As VBIDE.Reference)
        MsgBox "Удалена ссылка : " & Reference.Name & _
        vbCrLf & Reference.FullPath, , ""
    End Sub

  • Ответ :

    Для того, что Вы могли "контролировать" добавление и удаление ссылок вручную (т.е. отследить выбор команды Ссылки / References в меню Сервис / Tools и запретить отображение стандартного диалогового окна) достаточно скопировать нижеопубликованный код в модуль ThisWorkbook(ЭтаКнига) личной книги макросов "Personal.xls"
  • Private WithEvents iCommandBarEvent As VBIDE.CommandBarEvents
    'Следующая библиотека обязательно должна быть подключена
    'Microsoft Visual Basic for Applications Extensibility x.x

    Private Sub Workbook_Open()
        With Application.VBE
             Set iCommandBarEvent = .Events.CommandBarEvents(.CommandBars("Tools").Controls(1))
        End With
    End Sub

    Private Sub iCommandBarEvent_Click(ByVal CommandBarControl As Object, Handled As Boolean, CancelDefault As Boolean)
        CancelDefault = True
    End Sub

    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff