Страницы: 1
RSS
Редактирование макроса в книге другим макросом
 
Цель макросом из личной книги макросов при его запуске обновить рабочий файл до последней версии.
Помимо изменений в структуре данных, также требуется отредактировать часть кода существующих макросов зашитых в этот рабочий файл.

Можно ли получить как-то содержимое макроса из открытой книги в переменную, а потом replace- ом заменить необходимый кусок и перезаписать его?
Изменено: Александр - 13.01.2021 16:04:49
 
Тема не новая, подобный вопрос был здесь, там посмотрите #6, хорошая ссылка.
 
можно давать ссылку сразу на конкретный пост, кликнув по #
пример
Изменено: Jack Famous - 14.01.2021 09:08:19
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
DANIKOLA, спасибо, буду пробовать

в примере можно обращаться к модулю, который содержит макрос, будем надеяться с ним сработает replace
Жаль нельзя обратиться непосредственно к макросу по его имени например  :(  
 
Цитата
Александр написал:
нельзя обратиться непосредственно к макросу по его имени
почему нет? Если знаете имя, то проблем нет. Например, вот этот код запоминает в переменную res весь текст искомой процедуры/функции:
Код
Sub GetSubText()
    Dim objVBProj As Object
    Dim sProcName As String, res As String
    Dim lProcLineNum As Long, lProcLinesCnt As Long, lProcKind As Long, vMdl
    
    sProcName = "Макрос1" 'имя процедуры или функции, которые ищем
    Set objVBProj = ActiveWorkbook.VBProject
    On Error Resume Next
    
    'цикл по всем модулям проекта(стандартные, классы, формы, листы, книги)
    For Each vMdl In objVBProj.VBComponents
        For lProcKind = 0 To 3
            lProcLineNum = vMdl.CodeModule.ProcStartLine(sProcName, lProcKind)
            If lProcLineNum > 0 Then
                lProcLinesCnt = vMdl.CodeModule.ProcCountLines(sProcName, lProcKind)
                res = vMdl.CodeModule.Lines(lProcLineNum, lProcLinesCnt)
                MsgBox res
                Exit Sub
            End If
        Next
    Next
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Jack Famous написал:
можно давать ссылку сразу на конкретный пост, кликнув по #
а я и не знал) спасибо.
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
почему нет? Если знаете имя, то проблем нет.
Отлично! Спасибо
 
Не вышло изменить макрос =(

ни при попытке обратиться к самому макросу:
Код
Sub GetSubText()
    Dim objVBProj As Object
    Dim sProcName As String, res As String
    Dim lProcLineNum As Long, lProcLinesCnt As Long, lProcKind As Long, vMdl
     
    sProcName = "КвазиИнтерполAll" 'имя процедуры или функции, которые ищем
    Set objVBProj = ActiveWorkbook.VBProject
    On Error Resume Next
     
    'цикл по всем модулям проекта(стандартные, классы, формы, листы, книги)
    For Each vMdl In objVBProj.VBComponents
        For lProcKind = 0 To 3
            lProcLineNum = vMdl.CodeModule.ProcStartLine(sProcName, lProcKind)
            If lProcLineNum > 0 Then
                lProcLinesCnt = vMdl.CodeModule.ProcCountLines(sProcName, lProcKind)
                'MsgBox lProcLinesCnt
                ChangeMe = vMdl.CodeModule.Lines(lProcLineNum, lProcLinesCnt)
                'Часть макроса которую хотим поменять
                Text1 = "RowsStart = 120"
                'Часть макроса на который хотим поменять
                Text2 = "RowsStart = 124"
                'в текстовой переменной производим замену нужного участка кода
                ChangeMe = Replace(ChangeMe, Text1, Text2)
                'записываем изменения в макрос
                vMdl.CodeModule.Lines(lProcLineNum, lProcLinesCnt) = ChangeMe
                'vMdl.CodeModule.ProcCountLines(sProcName, lProcKind) = lProcLinesCnt
                MsgBox ChangeMe
                Exit Sub
            End If
        Next
    Next
    
End Sub


ни при попытке обращения к модулю
Код
Sub ChangeSubText()
'имя модуля для копирования
    sModuleName = "Season"
    On Error Resume Next
    'проект книги, из которой копируем модуль
    'Set objVBProj = ActiveWorkbook.VBProject
    Set objVBProj = ThisWorkbook.VBProject
    'необходимый компонент
    Set objVBComp = objVBProj.VBComponents(sModuleName)
    'Часть макроса которую хотим поменять
    Text1 = "RowsStart = 120"
    'Часть макроса на который хотим поменять
    Text2 = "RowsStart = 124"
    'objVBComp = Replace(objVBComp, Text1, Text2)
    objVBProj.VBComponents(sModuleName) = objVBComp.ReplaceLine(130, "RowsStart = 124")
End Sub

Раз объекты как таковые существуют и к ним можно обращаться, то способ их изменить должен быть, но не понимаю что именно я делаю не так.
Изменено: Александр - 27.01.2021 11:47:15
 
наверно не разрешили в настройках безопасности программы обращаться к этим объектам.
По вопросам из тем форума, личку не читаю.
 
Добавил -
Цитата
Tools-References-Microsoft Visual Basic For Applications Extensibility 5.X
Включено -
Цитата
Файл -Параметры -Центр управления безопасностью -Параметры макросов -поставить галочку «Доверять доступ к объектной модели проектов VBA»
 
Нашел рабочий код тут. Работает с личной книги макросов.
Только там код меняет код во всех открытых книгах, ниже закоментил эти куски и проставил чтобы код менялся в активной книге и только в указанном модуле

Код
Option Explicit

Sub ReplaceTextInCodeModules()

' Must add a reference to "Microsoft Visual Basic For Applications Extensibility 5.3"
' Also must set "Trust access to the VBA project object model"
' See the url below for more info on these.
' Based on code found at:
' Source: www.cpearson.com/excel/vbe.aspx Copyright 2013, Charles H. Pearson

Dim theWorkbook As Workbook
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim numLines As Long ' end line
Dim lineNum As Long
Dim thisLine As String
Dim message As String
Dim numFound As Long

Const FIND_WHAT As String = "RowsStart = 124"
Const REPLACE_WITH As String = "RowsStart = 150"

    numFound = 0

    'For Each theWorkbook In Application.Workbooks
        Set theWorkbook = ActiveWorkbook
        If theWorkbook.Name <> ThisWorkbook.Name Then
            If theWorkbook.HasVBProject Then
                Set VBProj = theWorkbook.VBProject
                'For Each VBComp In VBProj.VBComponents
                    Set VBComp = VBProj.VBComponents("Season")
                    Set CodeMod = VBComp.CodeModule

                    With CodeMod
                        numLines = .CountOfLines
                        For lineNum = 1 To numLines
                            thisLine = .Lines(lineNum, 1)
                            If InStr(1, thisLine, FIND_WHAT, vbTextCompare) > 0 Then
                                message = message & theWorkbook.Name & " | " & VBComp.Name & " | Line #" & lineNum & vbNewLine
                                .ReplaceLine lineNum, Replace(thisLine, FIND_WHAT, REPLACE_WITH, , , vbTextCompare)
                                numFound = numFound + 1
                            End If
                        Next lineNum
                    End With
                'Next VBComp
            End If
        End If
    'Next theWorkbook

    Debug.Print "Found: " & numFound
    If message <> "" Then
        Debug.Print message
    End If

End Sub
Страницы: 1
Наверх