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.
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
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
Par avance je vous remercies.
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
Cordialement.
Marc COTTÉ.
Partager