Bienvenue chez moi

Le web propose beaucoup de lecture sur ce sujet surtout pour Excel moins sur Access, voir d'ailleurs sur Developpez.com ces posts très intéressants:
http://www.developpez.net/forums/d27...-frm-d-projet/
http://www.developpez.net/forums/d10...d-base-access/


L'objectif
Je veux remplacer le code VBA d'un formulaire ou d'un rapport par celui d'un fichier, par défaut .CLS

Le problème
La routine pompée sans vergogne sur les 2 posts cités plus haut, charge tous les .CLS comme un nouveau module et ne remplace donc pas le code du formulaire ou du rapport :


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
Sub importVBACode(pPathImportDir As String)
 
    Dim sFileName As String, sExt As String
 
    If ExisteDir(pPathImportDir) = False Then MsgBox "Répertoire inexistant!" & Chr(13) & "Opération annulée!", vbCritical: Exit Sub
 
    sFileName = Dir(pPathImportDir & "*.*")
    Do While sFileName <> ""
        sExt = Right(sFileName, 3)
        Select Case sExt
            Case "cls", "bas"
                Application.VBE.ActiveVBProject.VBComponents.Import (pPathImportDir & sFileName)
        End Select
        sFileName = Dir
    Loop     
End Sub
 
Function ExisteDir(pPathDir As String) As Boolean
 
    On Error Resume Next
      ExisteDir = GetAttr(pPathDir) And vbDirectory
 
End Function
UNE EST LA BIENVENUE


Pour ceux qui cherchent encore, la routine d'import, toujours pompée férocement sur les 2 posts cités
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
Sub exportVBACode(pPathExportDir As String)
 
    Dim obj As Access.AccessObject
    Dim IdFile As Integer
    Dim sMsg As String
 
    ' Traiter tous les modules un par un
    sMsg = "Ecraser le fichiers VBA des modules (.bas)?"
    If OverWriteFile(sMsg) = False Then Exit Sub
 
    For Each obj In CurrentProject.AllModules
        DoCmd.OpenModule obj.Name
 
        ' Ouvrir le fichier texte
        IdFile = FreeFile
        Open pPathExportDir & obj.Name & ".bas" For Output As #IdFile
 
        DoCmd.Close acModule, obj.Name
 
        ' Ferme le fichier texte
        Close #IdFile
    Next
 
 
    'Traiter tous les formulaires un par un
    sMsg = "Ecraser le fichiers VBA des formulaires (.cls)?"
    If OverWriteFile(sMsg) = False Then Exit Sub
 
    For Each obj In CurrentProject.AllForms
        DoCmd.OpenForm obj.Name, acDesign
        If Forms(obj.Name).HasModule Then
            ' Ouvrir le fichier texte
            IdFile = FreeFile
            Open pPathExportDir & "Form_" & obj.Name & ".cls" For Output As #IdFile
 
            ' Ferme le fichier texte
            Close #IdFile
        End If
        DoCmd.Close acForm, obj.Name
    Next
 
 
    'Traiter tous les états un par un
    sMsg = "Ecraser le fichiers VBA des état (.cls)?"
    If OverWriteFile(sMsg) = False Then Exit Sub
 
    For Each obj In CurrentProject.AllReports
        DoCmd.OpenReport obj.Name, acDesign
        If Reports(obj.Name).HasModule Then
            IdFile = FreeFile
            Open pPathExportDir & "Report_" & obj.Name & ".cls" For Output As #IdFile
            ' Ferme le fichier texte
            Close #IdFile
 
        End If
        DoCmd.Close acReport, obj.Name
    Next
 
    MsgBox "Opération terminée !", vbInformation, "Code VB exporté"
End Sub
 
Private Function OverWriteFile(pMsg As String) As Boolean
 
    Dim bEcraseFile As Boolean
 
    oOverWrite = True
    If MsgBox(pMsg, vbQuestion + vbYesNo + vbDefaultButton2, "Export Modules") = vbNo Then
        oOverWrite = False
    End If
    OverWriteFile = oOverWrite
 
End Function
Voilà et n'oubliez pas, bonjour chez vous