תחומים - פורום חרדי מקצועי

קוד vba לייצוא מודולים

Sub ייצוא_מודולים()
'נוצר על ידי pcinfogmach

Dim sourceDoc As Object ' מסמך מקור המכיל את המודולים
Dim targetDoc As Object ' מסמך יעד להעתקת המודולים אליו
Dim sourceModule As Object ' מודול מקור
Dim targetModule As Object ' מודול יעד
Dim fileDialog As Object ' דיאלוג לבחירת קובץ
Dim savePath As String ' נתיב לשמירת המודולים המיוצאים
Dim mysavePath As String ' נתיב לשמירת המודולים המיוצאים
Dim saveFolder As Object ' דיאלוג לבחירת תיקייה
    
    ' יצירת דיאלוג לבחירת קובץ
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    
    ' אפשרות לבחירת קובץ יחיד בלבד
    fileDialog.AllowMultiSelect = False
    
'    הגדרת הכותרת והסינונים לדיאלוג
    fileDialog.Title = "בחר מסמך מקור"
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "מסמכי וורד", "*.docm; *.dotm; *.dot"
    
    ' הצגת הדיאלוג ובדיקה אם נבחר קובץ
    If fileDialog.Show = -1 Then
    ' הגדרת הקובץ הנבחר כמסמך המקור
        Set sourceDoc = Documents.Open(fileDialog.SelectedItems(1))
        
    ' יצירת דיאלוג לבחירת תיקיית יעד
    Set saveFolder = Application.fileDialog(msoFileDialogFolderPicker)
    ' הגדרת הכותרת לדיאלוג
    saveFolder.Title = "בחר תיקיית יעד"

            ' הצגת הדיאלוג ובדיקה אם נבחרה תיקייה
        If saveFolder.Show = -1 Then
                    ' הגדרת התיקייה הנבחרת כנתיב השמירה
            savePath = saveFolder.SelectedItems(1) & Application.PathSeparator

        ' לולאה על כל מודול במסמך המקור
        For Each sourceModule In ActiveDocument.VBProject.VBComponents
         'קבלת שם המודול
                Dim moduleName As String
                moduleName = sourceModule.Name
                
            ' בניית נתיב הקובץ לשמירת המודול המיוצא באמצעות השם המקורי
            If sourceModule.Type = 1 Or sourceModule.Type = 100 Then
                mysavePath = savePath & moduleName & ".bas"
            ElseIf sourceModule.Type = 2 Then
                mysavePath = savePath & moduleName & ".cls"
            ElseIf sourceModule.Type = 3 Then
                mysavePath = savePath & moduleName & ".frm"
            End If
            
     ' ייצוא המודול מהמסמך המקור באמצעות נתיב הקובץ
                sourceModule.Export mysavePath

        Next sourceModule
        
      ' סגירת המסמך המקור בלי שמירת שינויים
        sourceDoc.Close False
    End If
    End If
End Sub