-
אני רוצה ליצור מאקרו (XLSB) שעושה דברים מסויימים על הקובץ הפעיל, ואחד מהדברים הוא שיעשה קוד על הגליון
Private Sub Worksheet_SelectionChange(ByVal Target As Range) bla bla End Sub האם אפשרי כזה דבר?!
-
@חנון-המרבה הכוונת למשהו כזה - יצירת מודול באמצעות מאקרו
או להזרקת קוד? -
@Y-Excel-Access אני רוצה שקוד מאקרו ייצור קוד על הגליון
(לא הצלחתי לגמרי להבין את הקישור שהבאת, בעיקר בגלל שכל התמונות אינן מפוענחות ע"י נטפרי. תודה רבה) -
@חנון-המרבה רק שתדע, כיון שאופציה זו היא פירצה מאוד בעייתית מבחינת אבטחה, כברירת מחדל היא נעולה באקסל, והמשתמש צריך לאפשר גישה למודול 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
(הירוק).
יש לך פתרון -
זה לא מפתיע שזו תהיה התוצאה. יש כאן רצף של בעיות:
- הקוד מנסה למחוק את הקלאס של
גיליון1
, אני בספק אם בכלל אפשר למחוק קלאס כזה. - גם אם כן, בודאי שאי אפשר להריץ קוד כזה מתוך
גיליון1
. זו תהיה התאבדות... - יתכן ושם הקוד של
גיליון1
הוא בכללSheet1
... - כיון שפעולת המחיקה לא הצליחה, ממילא פעולת ההוספה יוצרת מודול חדש עם השם החדש
גיליון11
, כברירת מחדל במקרה שכבר קייםגיליון1
. - אגב, האם אתה באמת רוצה למחוק את כל הקוד שכבר קיים ב
גיליון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"
אתה מלך!!! זה בדיוק בדיוק מה שאני צריך (כמו שכתבתי בכותרת
מאקרו שכותב מאקרו אחר
) -
8/8