[Débutant] exporter le code VB d'un formulaire en fichier texte

**Tetsuotil** · 10/08/2006, 11h43

Bonjour,

Je souhaite créer un bouton de commande dans un formulaire permettant d'exporter le code VB de ce formulaire. Ceci afin que les futurs utilisateurs du formulaire puissent consulter ce code, l'imprimer et également créer une copie de sauvegarde de ce code afin de pouvoir le copier/coller dans ACCESS, par exemple, si une modification involontaire est faite dans le code du fichier ACCESS.
J'ai trouvé sur le site cette méthode de caféine, mais j'aimerais savoir s'il n'existe pas une commande moins complexe (même si celle-ci est moins efficace):

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Option Explicit
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Function xPortCode(ByVal modName As String, ByVal sizeFont As Integer, ByVal MeHwnd As Long)
 
    Dim i As Long
    Dim t0 As Single, t1 As Single
    Dim Fic As Integer
    Dim strBuff As String
    Dim reg As VBScript_RegExp_55.RegExp
    Dim KeyWords() As String, KeyWordsList As String
    Dim Types() As String, TypesList As String
    t0 = Timer
 
    Set reg = New VBScript_RegExp_55.regexp
    Fic = 1
 
    Reset
 
    ' ouverture du fichier en écriture
    Open "d:\temp\export " & modName & " (" & Format(Now, "yy-mm-dd") & ").html" For Output As #Fic
 
    ' écriture des en-têtes HTML et style
    Print #Fic, "<HTML>"
    Print #Fic, "<HEAD><TITLE>Export au format HTML du module : " & modName & "</TITLE>"
    Print #Fic, "<meta http-equiv=""Content-Type"" content=""text/html; charset=ISO-8859-1"" />"
    Print #Fic, "<style type='Text/css'>"
    Print #Fic, "<!--"
    Print #Fic, "BODY {"
    Print #Fic, "margin-top:0; margin-left:10; margin-right:0;"
    Print #Fic, "font-family: Lucida Console, Tahoma, Verdana, Arial, Helvetica, sans-serif;"
    Print #Fic, "font-size: " & sizeFont & "px;" ' la variable argument sizeFont passe dans la définition du style
    Print #Fic, "}"
    Print #Fic, ".commentaire {"
    Print #Fic, "color: #669933;"
    Print #Fic, "}"
    Print #Fic, ".chaine {"
    Print #Fic, "color: #993399;"
    Print #Fic, "}"
    Print #Fic, ".key {"
    Print #Fic, "color: #0033BB;"
    Print #Fic, "}"
    Print #Fic, ".type {"
    Print #Fic, "font-weight: bold;"
    Print #Fic, "color: #3366CC;"
    Print #Fic, "}"
    Print #Fic, "-->"
    Print #Fic, "</style>"
    Print #Fic, "</HEAD>"
    Print #Fic, "<BODY>"
 
 
    ' ouverture du module
    DoCmd.OpenModule modName
 
    ' récupération du texte du module
    strBuff = Application.Modules(modName).Lines(1, Application.Modules(modName).CountOfLines)
 
    ' empêcher les ouvertures de tag HTML
    strBuff = Replace(strBuff, "<", "&lt;")
 
    ' les retours chariot
    reg.Pattern = "(\n)"
    reg.Global = True
    reg.IgnoreCase = True
    strBuff = reg.Replace(strBuff, "$1<br />")
 
 
    ' 1- les mots-clé
    KeyWordsList = "AddressOf©Alias©And©As©ByRef©ByVal©Call©Case©Close©CBool©CByte©CCur©" & _
            "CDate©CDec©CDbl©CInt©CLng©CSng©CStr©CVar©Const©Compare©Database©Declare©Debug©Default©" & _
            "Dim©Do©Each©Else©ElseIf©End©Enum©Erase©Error©Explicit©Event©Exit©False©For©" & _
            "Friend©Function©Get©GoTo©Handles©If©Implements©Imports©In©Inherits©" & _
            "Interface©Is©Let©Lib©Like©Loop©Me©Mod©New©Next©Not©Nothing©" & _
            "On©Open©Option©Optional©Or©ParamArray©Preserve©Print©Private©Property©Protected©" & _
            "Public©RaiseEvent©ReadOnly©Redim©REM©Resume©Return©Select©Set©Shared©Static©" & _
            "Step©Stop©Sub©Then© To ©True©Type©TypeOf ©Until©UBound©When©Wend©While©With©WithEvents©WriteOnly©Xor"
 
    KeyWords = Split(KeyWordsList, "©")
    For i = 0 To UBound(KeyWords)
        reg.Pattern = "(\W|^)(" & KeyWords(i) & ")(\W|$)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<span class=key>$2</span>$3")
    Next i
 
    ' 2- les commentaires
    '  les REM
    reg.Pattern = "(\s)(rem .*)"
    reg.Multiline = False
    reg.Global = True
    reg.IgnoreCase = True
    strBuff = reg.Replace(strBuff, "$1<span class=commentaire>$2</span>")    
 
    '  les apostrophes (')
    reg.Pattern = "(\n)(([^\x22\n]*\x22[^\x22\n]*\x22)*)([^\x22\n']*)('.*)"
    reg.Multiline = False
    reg.Global = True
    reg.IgnoreCase = True
    strBuff = reg.Replace(strBuff, "$1$2$4<span class=commentaire>$5</span>")
 
    ' 3- les types
    TypesList = "Boolean©Byte©Date©Double©Integer©Long©Object©Short©Single©String©Unicode©Variant"
    Types = Split(TypesList, "©")
    For i = 0 To UBound(Types)
        reg.Pattern = "(\W|^)(" & Types(i) & ")(\W|$)"
        reg.Multiline = False
        reg.Global = True
        reg.IgnoreCase = True
        strBuff = reg.Replace(strBuff, "$1<span class=type>$2</span>$3")
    Next i
 
    ' 4- les chaines
    reg.Pattern = "(\x22[^\x22\n]*\x22)"
    reg.Multiline = False
    reg.Global = True
    reg.IgnoreCase = True
    strBuff = reg.Replace(strBuff, "<span class=chaine>$1</span>")
 
    ' Highlight dans un Highlight
    reg.Pattern = "(<span class=\w{6,11}>)(.*)(<span class=\w{3,11}>)(.*)(</span>)(.*</span>)"
    reg.Multiline = False
    reg.Global = True
    reg.IgnoreCase = True
    Do While reg.Test(strBuff)
        strBuff = reg.Replace(strBuff, "$1$2$4$6")
    Loop
 
    ' les espaces
    strBuff = Replace(strBuff, "  ", "  ")
 
    ' écriture de la chaîne dans le fichier
    Print #Fic, strBuff
 
    ' fermeture du module
    DoCmd.Close acModule, modName
 
    Print #Fic, "</BODY>"
    Print #Fic, "</HTML>"
 
    ' libération des objets mémoire
    Reset
    Set reg = Nothing
 
    'Ouverture du fichier HTML
    ' si un Hwnd de formulaire est passé en argument ...
    If MeHwnd <> 0 Then
        ShellExecute MeHwnd, "open", "d:\temp\export " & modName & " (" & Format(Now, "yy-mm-dd") & ").html", "", CurrentProject.Path, 1
    End If
 
    t1 = Timer
 
    Debug.Print "Job done @ " & Format(t1 - t0, "0.000") & " s"
 
End Function

Merci d'avance pour votre aide

**Tetsuotil** · 10/08/2006, 13h00

Je me suis tourné vers une autre solution:
j'ai entré le code suivant (basé sur une méthode trouvée dans les FAQ):

Code :

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

1
2
3
4
Private Sub Commande204_Click()
DoCmd.OutputTo acOutputModule, "Form_ens sup (Code)", acFormatRTF, "c:\mes documents\Code_VB.doc", True
 
End Sub

Mais ACCESS m'affiche le message d'erreur suivant:

Erreur d'exécution '2282':
Les formats qui vous permettent d'exporter des données au format Microsoft Excel, RTF (rich-text format), fichier texte MS DOS ou HTML sont manquants dans la base de registres Windows

J'ai tenté de résoudre le problème en activant la MicrosoftWord 9.0 Object Library mais cela ne fonctionne pas.

Comment peut-on faire pour régler ce bug ou simplifier la version exposée dans le message précédent ?

**Muhad'hib** · 10/08/2006, 16h03

Salut,

Tu peux utiliser les outils de la FAQ (proposés par Maxence HUBICHE) pour générer un simple fichier txt :

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
 
Option Compare Database
'Créer un fichier :
Function CreerFichier(ByVal sPath As String)
    Dim fso As FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CreateTextFile sPath
    Set fso = Nothing
End Function
 
 
'Ajouter une ligne :
Function AjoutLigneDansFichier(ByVal sPath As String, ByVal sTexte As String)
    Dim fso     As FileSystemObject
    Dim fFile   As File
    Dim ts      As TextStream
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fFile = fso.GetFile(sPath)
    Set ts = fFile.OpenAsTextStream(ForAppending)
 
    ts.WriteLine sTexte
 
    ts.Close
    Set ts = Nothing
    Set fFile = Nothing
    Set fso = Nothing
End Function
 
 
Public Sub SvgCode(Arg_Form As String)
Dim Code As Module
Dim Nom As String
 
 
DoCmd.OpenForm Arg_Form, acDesign, , , , acHidden
Set Code = Forms(Arg_Form).Module
 
 
Nom = CurrentProject.Path & "\svg code " & Code.Name & " " & Format(Now, "dd_mm_yyyy hh_nn") & ".txt"
CreerFichier (Nom)
AjoutLigneDansFichier Nom, Code.Lines(1, Code.CountOfLines)
 
DoCmd.Close acForm, Arg_Frm, acSaveNo
 
Set Code = Nothing
End Sub

A+

**Muhad'hib** · 16/08/2006, 12h29

Re,

Pour détailler :

Si tu veux archiver le code du formulaire "frm_saisie" tu fais juste :

Code :

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

1
2
3
 
 
SvgCode "frm_saisie"

Si tu veux archiver le code de tous tes formulaire :

Code :

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

1
2
3
4
5
6
7
 
 
Dim I As Integer
For I = 0 To CurrentProject.AllForms.Count - 1
    SvgCode CurrentProject.AllForms(I).Name
 
Next

A+

[Débutant] exporter le code VB d'un formulaire en fichier texte

Access

Discussions similaires

Partager

Partager