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. Как в редакторе VBA убрать все панели инструментов, включая контекстные меню, а также скрыть все "вспомогательные" окна ? 11.03.2011
  2. Как закомментировать весь макрос средствами VBA ? 01.04.2011
  3. Как в редакторе VBA создать кнопку, а также макрос, позволяющий сохранять все модули (имя модуля + дата и время сохранения) активного VBProject'а ? 09.05.2011
  4. Как получить хэндл главного окна редактора VBA ? (без использования WinAPI) 09.06.2014
  5. Как создать/удалить стандартный модуль, даже при отсутствии доверянного доступа к Visual Basic Project ? 09.05.2014
  6. Как программно создать стандартный модуль и макрос, текст которого, будет находиться в ячейках определённого рабочего листа ? NEW 01.10.2016
  7. Как программно импортировать текстовый файл .bas или .txt, содержащий программный код (макрос) ? NEW 01.10.2016
  8. Как узнать имеет ли Книга/VBProject цифровую подпись ? 23.06.2014
    [1] [2]


  • Ответ :

    Для того, чтобы в редакторе VBA заблокировать все панели инструментов, включая собственные панели и контекстные меню, а также убрать все "вспомогательные" окошки, типа : Локальные переменные, Окно проекта и т.д. достаточно выполнить макрос UserInterfaceVBE(), а для того, чтобы разблокировать панели инструментов, а также отобразить некоторые окна, можно выполнить макрос RestoreInterfaceVBE()
  • Private Sub UserInterfaceVBE()
        Dim iCommandBar As CommandBar, iWindow As Object
        For Each iCommandBar In Application.VBE.CommandBars
            iCommandBar.Enabled = False
        Next
        For Each iWindow In Application.VBE.Windows
            iWindow.Visible = False ' iWindow.Close
        Next
    End Sub
    
    Private Sub RestoreInterfaceVBE()
        Dim iCommandBar As CommandBar, iWindow As Object
        For Each iCommandBar In Application.VBE.CommandBars
            iCommandBar.Enabled = True
        Next
        For Each iWindow In Application.VBE.Windows
            Select Case iWindow.Type
                Case 0, 6, 7: iWindow.Visible = True
            End Select
            'If iWindow.Type = 6 Then iWindow.Visible = True
        Next
    End Sub
    Примечание : К сожалению, даже после скрытия окон, некоторые из них довольно легко отобразить, причём без использования VBA, т.к. существуют горячие клавиши, типа, F2, F4, CTRL + G и т.д.

    Значения свойства Type объекта Window перечислены в следующей таблице:
    
    Константа                    Значение    Описание
    vbext_wt_CodeWindow          0           Окно программы
    vbext_wt_Designer            1           Окно конструктора
    vbext_wt_Browser             2           Окно поиска объекта
    vbext_wt_Watch               3           Область контрольных значений
    vbext_wt_Locals              4           Национальные настройки
    vbext_wt_Locals              4           Окно локальных переменных
    vbext_wt_Immediate           5           Область проверки
    vbext_wt_ProjectWindow       6           Окно проекта
    vbext_wt_PropertyWindow      7           Окно свойств
    vbext_wt_Find                8           Диалоговое окно поиска
    vbext_wt_FindReplace         9           Диалоговое окно поиска и замены
    vbext_wt_Toolbox             10          Набор инструментов
    vbext_wt_LinkedWindowFrame   11          Рамка связанных окон
    vbext_wt_MainWindow          12          Главное окно
    vbext_wt_Preview             13          Окно предварительного просмотра
    vbext_wt_ColorPalette        14          Окно палитры цветов
    vbext_wt_ToolWindow          15          Tool Window
    
    Copyright(c) Microsoft Corporation 97 + XP

  • Ответ :

    Для того, чтобы программно закомментировать весь текст макроса, можно воспользоваться следующим советом. Обратите внимание на то, что :
  • ввод имени макроса вручную не является обязательным условием
  • поиск макроса будет осуществлён во всех модулях активной рабочей книги, однако, Вы можете указать и другой VBProject
  • если необходимо закомментировать все макросы с указанным именем, то уберите Exit For (вариант I)
  • указанная Вами процедура Sub не должна быть уже закомментирована, т.к. в этом случае возникнет ошибка (вариант I)
  • VBProject не должен быть защищён

    Вариант I.
  • Private Sub CommentProcedure() 
        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) - 1 
                    For iCount& = iStartLine& To iStartLine& + iCountLines& 
                        .ReplaceLine iCount&, "'" & .Lines(iCount&, 1) 
                    Next: Exit For 
                 End If 
            End With 
        Next 
    End Sub
    Вариант II. Скачать модуль3
    Private Sub CommentProcedure2()
        Dim iModules As Object, iModule As Object, iCodeModule As Object
        Dim iProcedure$, iMacros$, iCount&, iCountLines&
        
        iProcedure = InputBox(Prompt:="Введите имя макроса," & _
        vbCrLf & "который требуется закомментировать", Title:="")
        If iProcedure = "" Then _
        MsgBox "Вы не стали указывать имя макроса", , "": Exit Sub
        
        Set iModules = ActiveWorkbook.VBProject.VBComponents
        For Each iModule In iModules
            Set iCodeModule = iModule.CodeModule
            For iCount = 1 To iCodeModule.CountOfLines
                iMacros = iCodeModule.ProcOfLine(iCount, 0)
                If iMacros <> "" Then
                   iCountLines = _
                   iCount + iCodeModule.ProcCountLines(iMacros, 0)
                   If iMacros = iProcedure Then
                      Do
                           iCodeModule.ReplaceLine _
                           iCount, "'" & iCodeModule.Lines(iCount, 1)
                           iCount = iCount + 1
                      Loop Until iCount = iCountLines
                      Exit For 'закоммент. все макросы с именем iProcedure
                      'Exit Sub 'заком. первый попавшийся макрос iProcedure
                   Else
                      iCount = iCountLines - 1
                   End If
                End If
            Next
        Next
    End Sub

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

    Для того, чтобы Вы могли сохранить все модули активного VBПроекта в папку, где находится рабочая книга, содержащая этот проект, причём имя модуля будет содержать ещё и дату + время архивации (что позволит сохранить не только последнюю версию, но и предыдущие, а стало быть, при необходимости, Вы сможете просматривать их и сравнивать на предмет изменений) достаточно скопировать нижеопубликованный код в модуль ThisWorkbook(ЭтаКнига) личной книги макросов "Personal.xls" и использовать кнопку "Архив", которая будет доступна в редакторе VBA
  • Private WithEvents iCommandButtonEvent As VBIDE.CommandBarEvents
    'Следующая библиотека обязательно должна быть подключена
    'Microsoft Visual Basic for Applications Extensibility x.x
    
    Private Sub Workbook_Open()
        Dim iCommandBarButton As CommandBarButton
        With Application.VBE
             Set iCommandBarButton = .CommandBars(1).Controls.Add
             Set iCommandButtonEvent = .Events.CommandBarEvents(iCommandBarButton)
             With iCommandBarButton
                  .FaceId = 271
                  .Caption = "Архив"
                  .BeginGroup = True
                  .Style = msoButtonIconAndCaption
                  .TooltipText = "Archive ActiveVBProject"
             End With
        End With
    End Sub
    
    Private Sub iCommandButtonEvent_Click(ByVal CommandBarControl As Object, _
        Handled As Boolean, CancelDefault As Boolean)
        
        Dim iBuildFileName$, iFileName$, iPath$
        Dim iVBComponent As VBIDE.VBComponent '
        Dim iArchProject As VBIDE.VBProject '''
        Set iArchProject = Application.VBE.ActiveVBProject
        
        If iArchProject.Protection = vbext_pp_none Then
           If iArchProject.BuildFileName Like "*\*" Then
              iBuildFileName = iArchProject.FileName
              iFileName = Dir(iBuildFileName, vbHidden + vbReadOnly)
              iPath = Replace(iBuildFileName, iFileName, _
              "") & iArchProject.Name & " (" & iFileName & ")"
              
              If Dir(iPath, vbDirectory) = "" Then MkDir Path:=iPath
              
              For Each iVBComponent In iArchProject.VBComponents
                  iVBComponent.Export FileName:=iPath & "\" & _
                  iVBComponent.Name & Format(Now, " (dd_mm_yyyy hh-mm-ss).txt")
              Next
              MsgBox iPath, vbInformation, "Экспорт прошёл успешно"
           Else
              MsgBox "Рабочая книга должна быть сохранена", vbExclamation, ""
           End If
        Else
           MsgBox "VBProject «" & iArchProject.Name & "» защищён", vbCritical, ""
        End If
    End Sub
    Вариант I(б).
    Private WithEvents iCommandButtonEvent As VBIDE.CommandBarEvents
    'Следующая библиотека обязательно должна быть подключена
    'Microsoft Visual Basic for Applications Extensibility x.x
    
    Private Sub Workbook_Open()
        Dim iCommandBarButton As CommandBarButton
        With Application.VBE
             Set iCommandBarButton = .CommandBars(1).Controls.Add
             Set iCommandButtonEvent = .Events.CommandBarEvents(iCommandBarButton)
             With iCommandBarButton
                  .FaceId = 271
                  .Caption = "Архив"
                  .BeginGroup = True
                  .Style = msoButtonIconAndCaption
                  .TooltipText = "Archive ActiveVBProject"
             End With
        End With
    End Sub
    
    Private Sub iCommandButtonEvent_Click(ByVal CommandBarControl As Object, _
        Handled As Boolean, CancelDefault As Boolean)
        
        Dim iBuildFileName$, iFileName$, iPath$, iPosition%
        Dim iVBComponent As VBIDE.VBComponent
        Dim iArchProject As VBIDE.VBProject '
        Set iArchProject = Application.VBE.ActiveVBProject
        
        If iArchProject.Protection = vbext_pp_none Then
           iPosition = InStrRev(iArchProject.BuildFileName, "\")
           If iPosition > 0 Then
              iBuildFileName = iArchProject.FileName
              iPath = Mid(iBuildFileName, 1, iPosition)
              iFileName = Mid(iBuildFileName, iPosition + 1)
              
              iPath = iPath & iArchProject.Name & " (" & iFileName & ")\"
              If Dir(iPath, vbDirectory) = "" Then MkDir Path:=iPath
              
              For Each iVBComponent In iArchProject.VBComponents
                  iFileName = iPath & iVBComponent.Name & _
                  Format(Now, " (dd_mm_yyyy hh-mm-ss).txt")
                  iVBComponent.Export FileName:=iFileName
              Next
              MsgBox iPath, vbInformation, "Экспорт прошёл успешно"
           Else
              MsgBox "Рабочая книга должна быть сохранена", vbExclamation
           End If
        Else
           MsgBox "VBProject «" & iArchProject.Name & "» защищён", vbCritical
        End If
    End Sub

  • Ответ :

    Для того, чтобы получить дескриптор главного окна редактора VBA, причём без явного вызова WinAPI, достаточно использовать свойство hWnd об'екта MainWindow :
  • Private Sub getHandleWindowVBE()
        Dim ihWnd&
        ihWnd = Application.VBE.MainWindow.hWnd
        
        MsgBox "Хэндл главного окна редактора VBA = " & ihWnd
    End Sub
    Обратите внимание на то, что "скрытое" свойство hWnd есть у других окон редактора, правда в большинстве случаев, они возвращают 0
  • Ответ :

    Для того, чтобы создать стандартный модуль, при этом, не обращаясь к VBProject и стало быть не получая ошибок, вследствии отсутствия доверенного к нему доступа (актуально только для MS Excel XP и старше), достаточно воспользоваться любым из двух нижеопубликованных вариантов :

    Вариант I.
  • ThisWorkbook.Sheets.Add Type:=xlModule
    Вариант II.
    ThisWorkbook.Modules.Add
    Комментарий : второй вариант можно использовать для создания сразу нескольких модулей, причём без цикла, т.е.
    ThisWorkbook.Modules.Add Count:=3
    А для того, чтобы его удалить, достаточно указать его индекс(номер) или имя и использовать метод Delete, т.е.

    Вариант I.
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets("Модуль1").Delete
    Application.DisplayAlerts = True
    Вариант II.
    Application.DisplayAlerts = False
    ThisWorkbook.Modules(1).Delete
    Application.DisplayAlerts = True
    Комментарий : второй вариант удобно использовать для удаления всех стандартных модулей, созданных таких способом. Однако, необходимо учитывать, что если таких модулей не окажется, то Вы получите ошибку, которой можно избежать, если добавить соответствующую проверку, а именно If Modules.Count > 0 Then Modules.Delete
    Application.DisplayAlerts = False
    ThisWorkbook.Modules.Delete
    Application.DisplayAlerts = True

  • Ответ :

    Для того, чтобы в незащищённом VBProject текущей рабочей книги создать стандартный модуль, а в нём макрос, текст которого будет находиться в ячейках указанного рабочего листа, можно использовать нижеопубликованный макрос.
  • Private Sub InsertCodeFromRange()
        Dim iCell As Range
        For Each iCell In Range("'Код макроса'!A1:A100")
            iMacros$ = iMacros$ & vbCr & iCell.Text
        Next
        ThisWorkbook.VBProject.VBComponents.Add(1).CodeModule.AddFromString iMacros$
    End Sub
    В данном примере предполагается, что текст макроса располагается в ячейках A1:A100 рабочего листа с именем Код макроса

    Актуально для MS Excel 2000
    Начиная с этой версии, Вы можете обойтись без перебора ячеек, т.е.
    Private Sub InsertCodeFromRangeXL2000()
        iMacros$ = Join(Application.Transpose(Range("'Код макроса'!A1:A100")), vbCr)    
        ThisWorkbook.VBProject.VBComponents.Add(1).CodeModule.AddFromString iMacros$
    End Sub
    Примечание : Если же Вы являетесь апологетом сокращений, даже в ущерб читабельности, то поможете избавиться от переменной iMacros$
  • Ответ :

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

    Вариант I.
  • ThisWorkbook.VBProject.VBComponents.Import "C:\Модуль1.bas"
    Примечание : Если в текущей книге уже находится модуль с именем, которое совпадает с именем, которое, как правило, находится в самой первой строке текстового файла и выглядит так, Attribute VB_Name = "Модуль1", то импорт пройдёт успешно. Только имя нового модуля будет немного отличаться. Например, если мы импортируем модуль с именем "Модуль1", а такой уже есть, то появится "Модуль11". Если и такое имя уже занято, то "Модуль12" и т.д.

    Комментарий : Обратите внимание на то, что этот способ позволяет импортировать не только стандартный модуль, но и модуль класса .cls, а также формы .frm

    Вариант II.
    ThisWorkbook.VBProject.VBComponents.Add(1).CodeModule.AddFromFile "C:\Модуль1.bas"
    
    Примечание : При таком способе, сначала будет создан стандартный модуль. Затем, имя нового модуля будет изменено на указанное в файле, после чего, в новый модуль будет вставлено содержимое указанного файла. Если, на момент "импорта", в текущей книге уже находится модуль с таким именем, то возникнет ошибка 32813

    Вариант III.
    ThisWorkbook.Modules.Add.InsertFile "C:\Модуль1.bas"
    
    Примечание : Этот вариант аналогичен предыдущему, только позволяет создать модуль, даже при отсутствии доверенного доступа к VBProject. Но, если есть плюсы, значит есть и минусы. Во первых, так как мы создаём модуль листа, то структура книги не должна быть защищена, иначе возникнет ошибка 1004 А во вторых, если текстовый файл, текст которого мы "импортируем", содержит информацию о имени модуля, типа Attribute VB_Name = "Модуль1", то такого имени не должно быть не только среди модулей, но и среди листов (семейство Sheets)
  • Ответ :

    Актуально для MS Excel 2000, XP
  • If ThisWorkbook.VBASigned = True Then
       MsgBox "Книга/Проект имеет цифровую подпись"
    Else
       MsgBox "Книга/Проект не имеет цифровой подписи"
    End If
    Комментарий : разумеется, текущая книга использована исключительно в качестве примера и может быть заменена на любую другую открытую книгу.
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

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