|
Предисловие :
Все приведённые примеры неактуальны для MS Excel 95, т.к.
в этой версии нет многих об'ектов, в т.ч. и редактора VBA. В MS Excel XP, перед
выполнением приведённых примеров, необходимо предварительно в меню Сервис
выбрать пункт Макросы и команду Безопасность. Затем выделить
закладку Надёжные источники и установить
"флажок" Доверять доступ к Visual Basic Project. В противном случае, при
попытке доступа к VBProject, Вы получите ошибку.
[1] [2]
- Как добавить комментарии в макрос ? 2004
- Как закомментировать/раскомментировать
целый блок ? 21.03.2007
- Как проверить защищён(заблокирован) или нет VBProject ?
04.11.2008
- Как изменить имя VBProject стандартными средствами
и с помощью VBA ? 08.03.2009
- Как изменить имя модуля (других компонентов)
стандартными средствами и VBA ? 2004
- Как удалить текст макроса средствами VBA ? 20.05.2005
- Как удалить макрос средствами VBA ? 07.10.2007
- Как удалить модуль, модуль класса, UserForm
средствами VBA ? 30.05.2005
- Как удалить все стандартные модули, модули класса,
UserForm, а также удалить программный код из всех модулей листа, книги ?
06.01.2008
- Как удалить все пользовательские формы UserForm ?
03.09.2016
- Как закомментировать весь макрос
средствами VBA ? 01.04.2011
- Как добавить одну или несколько строк в нужное
место программы ? 29.07.2007
- Как заменить определённую строку программы на другую ?
29.07.2007
- Как удалить одну или несколько строк программы ?
29.07.2007
- Как определить общее количество строк в модуле ?
07.10.2007
- Как определить количество строк раздела описаний модуля ?
07.10.2007
- Как найти нужный текст во всех модулях книги ?
Как определить наличие определённого текста в модуле(ях) ? 15.09.2007
- Как заменить текст во всех модулях книги ? 09.04.2015
- Как получить список (имя книги, проекта, модуля,
процедуры) всех Sub макросов, находящихся в открытых рабочих книгах ?
04.11.2008
- Как получить список всех процедур (Sub, Function)
нужной рабочей книги ? 19.07.2010
- Как программно создать UserForm,
изменить значения нужных свойств, а затем отобразить созданную форму ?
16.06.2007
- Как экспортировать все стандартные модули из текущей
книги во вновь созданную рабочую книгу ? 30.06.2007
- Как экспортировать все модули текущей книги ?
03.07.2007
- Как в редакторе VBA создать кнопку, а также
макрос, позволяющий сохранить все модули (имя модуля + дата и время сохранения)
активного VBProject'а ? 09.05.2011
- Как определить/изменить имя рабочего листа, используемое
в среде VBA ? 05.05.2005
- Как получить доступ к рабочему листу (и листу диаграммы)
не используя его индекс или имя ? 18.04.2010
- Как получить доступ к рабочему листу, ячейкам,
с помощью кодового имени в виде переменной ? 18.04.2010
- Как при создании нового рабочего листа
синхронизировать имена этого листа ? 10.03.2007
- Как определить наличие программного текста в модуле ?
16.07.2006
- Как получить программный текст нужного модуля ?
11.03.2009
- Как осуществить просмотр программного
кода нужного макроса ? 28.06.2007
- Как осуществить просмотр кода нужного макроса,
т.е. программно открыть необходимый макрос в редакторе VBA ? 25.03.2012
- Как программно перейти в редактор VBA ? 03.03.2011
- Как программно подключить нужную библиотеку ?
Как программно добавить ссылку на библиотеку ? 11.02.2007
- Как программно удалить все "битые" ссылки ? 18.03.2011
- Как отследить подключение и отключение ссылок ?
07.10.2007
- Как запретить подключение и отключение ссылок вручную ?
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 iVBComponent = Application.VBE.SelectedVBComponent
iCountOfLines = iVBComponent.CodeModule.CountOfLines
If iCountOfLines <> 0 Then
iVBComponent.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 |
| | | | | | | | | | | |
| | | | | | | | | | | | | | | | | | | | | |
|