מאקרו שכותב מאקרו אחר

[חנון המרבה]

אני רוצה ליצור מאקרו (XLSB) שעושה דברים מסויימים על הקובץ הפעיל, ואחד מהדברים הוא שיעשה קוד על הגליון

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
bla bla
End Sub

האם אפשרי כזה דבר?!

[Y.Excel.Access]

@חנון-המרבה הכוונת למשהו כזה - יצירת מודול באמצעות מאקרו
או להזרקת קוד?

[חנון המרבה]

@Y-Excel-Access אני רוצה שקוד מאקרו ייצור קוד על הגליון

(לא הצלחתי לגמרי להבין את הקישור שהבאת, בעיקר בגלל שכל התמונות אינן מפוענחות ע"י נטפרי. תודה רבה)

[OdedDvir]

@חנון-המרבה רק שתדע, כיון שאופציה זו היא פירצה מאוד בעייתית מבחינת אבטחה, כברירת מחדל היא נעולה באקסל, והמשתמש צריך לאפשר גישה למודול VBA במרכז יחסי האמון:

[חנון המרבה]

@Y-Excel-Access בבדיקה נוספת ראיתי שזה יוצר/מעתיק מודולים ולא קוד של גליון

[חנון המרבה]

@Y-Excel-Access מצאתי כזה קוד (אני שם את הקוד בקובץ XLSB בגליון1 ומשם אני מעתיק את זה)

Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)

    ' Description:  copies a module from one workbook to another
    ' example: CopyModule Workbooks(ThisWorkbook), "Module2",
    '          Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
    ' Notes:   If Module to be copied already exists, it is removed first,
    '          and afterwards copied

    Dim strFolder                       As String
    Dim strTempFile                     As String
    Dim FName                           As String

    If Trim(strModuleName) = vbNullString Then
        Exit Sub
    End If

    If TargetWB Is Nothing Then
        MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
        Exit Sub
    End If

    strFolder = SourceWB.Path
    If Len(strFolder) = 0 Then strFolder = CurDir

    ' create temp file and copy "Module2" into it
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"

    On Error Resume Next
    FName = Environ("Temp") & "\" & strModuleName & ".bas"
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            MsgBox "Error copying module " & strModuleName & "  from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
            Exit Sub
        End If
    End If

    ' remove "Module2" if already exits in destination workbook
    With TargetWB.VBProject.VBComponents
        .Remove .Item(strModuleName)
    End With

    ' copy "Module2" from temp file to destination workbook
    SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
    TargetWB.VBProject.VBComponents.Import strTempFile

    Kill strTempFile
    On Error GoTo 0

End Sub

Public Sub Main()

Dim WB1 As Workbook
Dim WB2 As Workbook

Set WB1 = ThisWorkbook
Set WB2 = Workbooks("1324.xlsm")

Call CopyModule(WB1, "גיליון1", WB2)

End Sub

(מקור)

התוצאה היא שזה נכנס ל-Class Modules (הצהוב) ולא לגיליון1 (הירוק).

יש לך פתרון

[OdedDvir]

זה לא מפתיע שזו תהיה התוצאה. יש כאן רצף של בעיות:

1. הקוד מנסה למחוק את הקלאס של גיליון1, אני בספק אם בכלל אפשר למחוק קלאס כזה.
2. גם אם כן, בודאי שאי אפשר להריץ קוד כזה מתוך גיליון1. זו תהיה התאבדות...
3. יתכן ושם הקוד של גיליון1 הוא בכלל Sheet1...
4. כיון שפעולת המחיקה לא הצליחה, ממילא פעולת ההוספה יוצרת מודול חדש עם השם החדש גיליון11, כברירת מחדל במקרה שכבר קיים גיליון1.
5. אגב, האם אתה באמת רוצה למחוק את כל הקוד שכבר קיים בגיליון1 ?

נראה שהאופציה העדיפה כאן היא להוסיף שורות חדשות, על ידי המתודה AddFromString:

Sub AddStringToSheetModule(sheetName As String, codeText As String)
    With ActiveWorkbook.VBProject.VBComponents(Sheets(sheetName).CodeName).CodeModule
        .AddFromString codeText
    End With
End Sub

ואתה קורא לקוד כך:

AddStringToSheetModule "גיליון1", "Dim foo As String" + vbNewLine + "Dim bar As String"

הערות:

• כדי לייבא קובץ טקסט שלם, תקרא אותו לתוך המחרוזת.
• אין כאן שום בדיקות תקינות, האם הגליון קיים, והאם הקוד עדיין לא קיים במודול, וכו'

[חנון המרבה]

@OdedDvir אמר במאקרו שכותב מאקרו אחר:

Sub AddStringToSheetModule(sheetName As String, codeText As String)
    With ActiveWorkbook.VBProject.VBComponents(Sheets(sheetName).CodeName).CodeModule
        .AddFromString codeText
    End With
End Sub

ואתה קורא לקוד כך:

AddStringToSheetModule "גיליון1", "Dim foo As String" + vbNewLine + "Dim bar As String"

אתה מלך!!! זה בדיוק בדיוק מה שאני צריך (כמו שכתבתי בכותרת מאקרו שכותב מאקרו אחר)