mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Выгрузка списка макросов (или всего кода целиком) из проекта VBA в текстовый файл

Sub print_all_sub_and_function_names_of_current_project()
    ' пишет названия функций программы в файл c:\output.txt
    On Error Resume Next
    sub_list = "": Set iVBComponents = ThisWorkbook.VBProject.VBComponents
    For Each iVBComponent In iVBComponents
        Select Case iVBComponent.Type
            Case 1 To 100:
                With iVBComponent.CodeModule
                    sub_list = sub_list & "==============" & vbNewLine & .Name & vbNewLine & "==============" & vbNewLine
                    For i = 1 To .CountOfLines
                        If InStr(1, .Lines(i, 1), "Sub ") And InStr(1, .Lines(i, 1), "Exit ") = 0 And _
                           (InStr(1, .Lines(i, 1), "End Sub") > 15 Or InStr(1, .Lines(i, 1), "End Sub") = 0) Then
                            sub_list = sub_list & .Lines(i, 1) & vbNewLine
                        End If
                        If InStr(1, .Lines(i, 1), "Function ") And InStr(1, .Lines(i, 1), "Exit ") = 0 And _
                           (InStr(1, .Lines(i, 1), "End Function") > 15 Or InStr(1, .Lines(i, 1), "End Function") = 0) Then
                            sub_list = sub_list & .Lines(i, 1) & vbNewLine
                        End If
                    Next
                End With
        End Select
    Next
    Dim FSO As FileSystemObject, ts As TextStream, fil As File
    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FileExists("c:\output.txt") Then Kill "c:\output.txt"
 
    Set ts = FSO.OpenTextFile("c:\output.txt", 8, True)
    ts.Write sub_list: ts.Close: Set ts = Nothing: Set FSO = Nothing
End Sub

Пример того, что записывается в файл "c:\output.txt"

==============
Trace_Open_Save
==============
Sub test988d()
Function Get_InitialFileName_for_Trace() As String
Function SaveTrace(ByVal Filename As String, ByRef Tr As Trace) As Boolean
Sub test_LoadTrace(): Dim Tr As Trace: Set Tr = LoadTrace: Tr.Existed = True: Tr.Show: End Sub
Function LoadTrace(Optional ByVal Filename As String = "") As Trace
==============
Link
==============
Function ConvertHPPs(ByRef node As TraceNode, HPPind As Integer) As String
Function GetLinkInfo() As String
Sub Apply()
Private Sub Class_Initialize()
Sub MoveLink(ByRef WSource As Warrant, ByRef WDestination As Warrant)
Sub DeleteLink(ByRef WSource As Warrant)
Sub AddLink(ByRef WDestination As Warrant)
Sub Undo()

Sub print_all_code_of_current_project()
    ' пишет весь код данной программы в файл c:\code.vb
    On Error Resume Next
    sub_list = "": Set iVBComponents = ThisWorkbook.VBProject.VBComponents
    For Each iVBComponent In iVBComponents
        Select Case iVBComponent.Type
            Case 1 To 100:
                With iVBComponent.CodeModule
                    sub_list = sub_list & "==============  " & .Name & "  ==============" & vbNewLine
                    For i = 1 To .CountOfLines
                        codeline = Trim$(.Lines(i, 1))
                        If Len(codeline) > 0 Then sub_list = sub_list & codeline & vbNewLine
                    Next
                End With
        End Select
    Next
 
    Dim FSO As FileSystemObject, ts As TextStream, fil As File
    Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FileExists("c:\code.vb") Then Kill "c:\code.vb"
 
    Set ts = FSO.OpenTextFile("c:\code.vb", 8, True)
    ts.Write sub_list: ts.Close: Set ts = Nothing: Set FSO = Nothing
End Sub

Пример того, что записывается в файл "c:\code.vb"

============== Files_Control ==============
Public DectDB As New Collection
Public Enum FileIconConst
az_Cross = 1: az_Trace = 2: az_Warrant = 3: az_Distr = 4
az_Excel = 10: az_Access_Key = 50: az_Settings = 51: az_LogFile = 60
End Enum
Sub Reg_NewFileTypeEx(ByVal NewExtension As String, ByVal NewDescription As String, ByVal NewIcon As FileIconConst)
' регистрирует новый тип файла. иконка файла в соответствии с FileIconConst
Const az = "CompanyName"
SaveRegString HKEY_CLASSES_ROOT, NewExtension, "", az & NewExtension
SaveRegString HKEY_CLASSES_ROOT, az & NewExtension, "", NewDescription
SaveRegString HKEY_CLASSES_ROOT, az & NewExtension, "EditFlags", 0
Select Case NewIcon ' чтобы файлы можно было открыть EXCEL-ем без лишних вопросов о формате файла

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Вам нужно либо подключить к проекту библиотеку Microsoft Scripting Runtime (файл scrrun.dll), либо использовать "позднее связывание"

Класс! Спасибо.

Чтобы этот макрос заработал, надо в настройках Excel поставить галочку «Доверять доступ к объектной модели проектов VBA»
Это делается через меню Файл - Параметры - Центр управления безопасностью - Параметры центра управления безопасностью - Параметры макросов

Добрый день, такой вопрос, почему выводить пустой файл? Может быть проблема в excel-13 ??

Да, можно. Пример такого кода вроде был в книге Уокенбаха

Если проект VBA запаролен - то сделать тоже можно, но намного сложнее
(требуется снимать пароль через SendKeys)

Вообще, я ни разу не сталкивался с необходимостью такого импорта

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

Короче, я бы посоветовал вам отказаться от этой затеи.
Поверьте, есть способы обойтись без этого.

А можно ли, наоборот, импортировать из текстового файла в проект книги код VBA?

Попробуйте удалить строку кода (она не нужна)

Dim FSO As FileSystemObject, ts As TextStream, fil As File

(для этой строки требуется подключение дополнительной библиотеки)

ругается на sub_list = "":
Говорит что не может найти библиотеку.

что надо сделать для работы?

Очень полезная штука

А возможно выгрузить код модуля в файл если проект запаролен, а пароль не знаешь? :)

Ну так снимите пароль - для этого есть куча утилит, типа AOPR

Или откройте файл в OpenOffice - там сможете получить доступ к коду VBA без ввода пароля
(мой макрос в OpenOffice работать не будет)

подключите Micrsoft Runtime Script в tools->references...

А возможно выгрузить код модуля в файл если проект запаролен, а пароль не знаешь? :)

Пробую запустить примеры, редактор выделяет
FSO As FileSystemObject
и все, дальше не идет.
Что это может быть?

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _    ___    _  __    _   _   _   _   
| | / _ \ | |/ / (_) | | | | | |_
| | | | | | | ' / | | | |_| | | __|
| | | |_| | | . \ | | | _ | | |_
|_| \__\_\ |_|\_\ _/ | |_| |_| \__|
|__/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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