Discussion :

[cotmar]

Bonjour,

J'ai lu cette contribution.
Tous ces liens et ces exemples me sont très utiles. Merci.
J'ai du coup construit mon export de la manière suivante en pensant renommer les modules correspondant au classeur Excel (ThisWorkbook) et aux feuilles.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 
 
Sub ExporterSourcesFichierExcel()
    Dim LeFich      As Object
    Dim WbkSortie   As Workbook
 
    Dim StrNomFich  As String
    Dim StrNomRep   As String
    Dim StrTypeFic  As String
 
On Error GoTo Erreur
 
    StrNomFich = FctChoixFichier
 
    '0/ Vérifications
    '****************
    If StrNomFich = ThisWorkbook.Name Then
        Err.Number = -1
        Err.Description = "Vous ne pouvez pas écraser le claseur de l'importateur"
        GoTo Erreur
    End If
 
    '1/ Ouvre le fichier XLS
    '***********************
    If Not FctOuvreFichierXls(StrNomFich, StrNomRep, WbkSortie) Then
        GoTo Sortie
    End If
 
    '2/ Création du répertoire du projet :
    '    1- Nom du projet
    '    2- Date et heure du jour
    '*************************************
    If Not FctCreationDirectory("C:\" & WbkSortie.Name & "\") Then
'        If Err.Number Then
'            GoTo Sortie
'        End If
    End If
    StrNomRep = "C:\" & WbkSortie.Name & "\" & FormatDateTime(Date, vbLongDate)
    If Not FctCreationDirectory(StrNomRep) Then
    End If
 
    For Each LeFich In WbkSortie.VBProject.VBComponents
    '3/ Export des fichiers du projet
    '********************************
        Select Case LeFich.Type
            Case 100 '
                If LeFich.Name = "ThisWorkbook" Then
                    WbkSortie.VBProject.VBComponents(LeFich.Name).Export StrNomRep & "\" & LeFich.Name & ".wbk" 'Je force pour avoir un nom différent que "CLS"
                    StrTypeFic = "Workbook"
                Else
                    WbkSortie.VBProject.VBComponents(LeFich.Name).Export StrNomRep & "\" & LeFich.Name & ".wks"  'Je force pour avoir un nom différent que "CLS"
                    StrTypeFic = "Worksheet"
                End If
            Case 1 ' vbext_ct_StdModule
                WbkSortie.VBProject.VBComponents(LeFich.Name).Export StrNomRep & "\" & LeFich.Name & ".bas"
                StrTypeFic = "Module.BAS"
            Case 2 'vbext_ct_ClassModule
                WbkSortie.VBProject.VBComponents(LeFich.Name).Export StrNomRep & "\" & LeFich.Name & ".cls"
                StrTypeFic = "Module.CLS"
            Case 3 'vbext_ct_MSForm
                WbkSortie.VBProject.VBComponents(LeFich.Name).Export StrNomRep & "\" & LeFich.Name & ".frm"
                StrTypeFic = "Form"
        End Select
 
        '4/ Création du fichier texte avec la liste des fichiers du projet (date de modif)
        '*********************************************************************************
'        If Not FctEcrireFichier(StrNomRep & "\" & WbkSortie.Name & ".xlp", FormatDateTime(Date, vbLongDate) & " - " & FormatDateTime(Time, vbLongTime) & " - " & LeFich.Name & " - " & LeFich.Type & " - " & ThisWorkbook.Application.UserName) Then
'            GoTo Sortie
'        End If
    Next
 
Sortie:
    If Not IsNull(WbkSortie) Then
        WbkSortie.Close
        Set WbkSortie = Nothing
        Set LeFich = Nothing
    End If
    Exit Sub
 
Erreur:
    MsgBox Err.Number & " " & Err.Description, vbExclamation, "Export Import"
    GoTo Sortie
 
End Sub

Permettez moi d'ajouter une petite question dans cette discution : comment faire pour importer les modules de code VBA du classeur et des feuilles d'Excel s'il vous plait ? J'ai signalé les points qui me posent problème dans le code sur la procédure d'import correspondant à l'export du dessus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
 
 
 
Sub ImporterTousLesFichiersDunRépertoire()  '"d'après" SilkyRoad
    Dim StrNomFich      As String
    Dim StrNomRepe      As String
    Dim WbkActif        As Workbook
 
    Dim StrFicSortie    As String
 
On Error GoTo Erreur
 
    '1/ Je sélectionne le répertoir d'origine
    '****************************************
    StrNomRepe = FctChoixRepertoire     'Ouvre la boite de dialogue de sélection de répertoire
    If Trim(StrNomRepe) = "" Then GoTo Sortie
    StrNomFich = Dir(StrNomRepe & "\*.*") 
 
    '2/ Je sélectionne le fichier de destination (nouveau fichier)
    '*************************************************************
    If Not FctNouveauFichierXls(WbkActif) Then
        GoTo Sortie
    End If
    StrFicSortie = Split(StrNomRepe, "\")(1)
 
    '4/ J'importe tous les modules
    '*****************************
    ChDir StrNomRepe
    StrNomFich = Dir("") 
    Do While StrNomFich <> ""
        Select Case Split(StrNomFich, ".")(1)
            Case "xlp", "frx" 'Le log => on ne fait rien
            Case "wks" 'Worksheet => ne tiend pas compte de l'extention
                WbkActif.VBProject.VBComponents.Import (StrNomRepe & "\" & StrNomFich) 
                         '************************'
                         '=> PREMIER PROBLEME ICI'
                         '************************'
            Case "wbk" 'Workbook => ne tiend pas compte de l'extention
                WbkActif.VBProject.VBComponents.Import (StrNomRepe & "\" & StrNomFich) 
                         '************************'
                         '=> SECOND PROBLEME ICI'
                         '************************'
            Case Else
                WbkActif.VBProject.VBComponents.Import (StrNomRepe & "\" & StrNomFich)
        End Select
        StrNomFich = Dir
    Loop
 
    '5/ Je sauvegarde le fichier de résultat en XLAM (AddIn)
    '*******************************************************
    If Not FctSaveAs(StrFicSortie, StrNomRepe, xlAddIn, WbkActif) Then
 
    End If
 
Sortie:
    If Not IsNull(WbkActif) Then
        WbkActif.Close
        Set WbkActif = Nothing
    End If
    Exit Sub
 
Erreur:
    MsgBox Err.Number & " " & Err.Description, vbExclamation, "Export Import"
    GoTo Sortie
 
End Sub

Par avance je vous remercies.

Cordialement.

Marc COTTÉ.

[cotmar]

Bonjour,

Merci de cette intervention fort à propos et désolé d'avoir posté au mauvais endroit.

Sinon que pensez vous de ma question et de mon code s'il vous plait ?

Par avance je vous remercies.

Cordialement.

Marco.