modifier à la volée des formulaires avec un lancement de module

[emulamateur]

Bonsoir,

Ce code n'est pas de moi mais il a le mérite, lorsque vous voulez intégrer, à un nombre très substantiel de formulaires, la même procédure évènementielle (ici sur ouverture et fermeture du form) :

Code :

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
Option Compare Database
Option Explicit
 
Public Sub AddAlterFrmMdl()
 
Dim i As Integer
Dim save_flag As AcCloseSave
Dim open_call As String
Dim close_call As String
Dim frm As Form
Dim op_ret As Long
Dim cl_ret As Long
Dim st_line As Long
Dim end_line As Long
Dim st_col As Long
Dim end_col As Long
 
'################################################################################
'This code puts in the open and close logging for forms
 
'Code we want to insert in the open and close procedures.
open_call = "'Call OpenFunction (Me.Name)"
close_call = "'Call CloseFunction(Me.Name, 2)"
 
'Loop through the forms container
For i = 0 To Application.CurrentDb.Containers("Forms").Documents.Count - 1
 
'Open each form in design mode
    DoCmd.OpenForm Application.CurrentDb.Containers("Forms").Documents(i).Name, acDesign
 
'clear the save flag
    save_flag = acSaveNo
 
'instantiate our form object
    Set frm = Forms(Application.CurrentDb.Containers("Forms").Documents(i).Name)
 
    With frm
 
'Add a module if does not have one
 
        If .HasModule = False Then
            .HasModule = True
            save_flag = acSaveYes
        End If
 
        With .Module
 
'Look for the code.
'Note the st_line, st_col, end_line, end_col variables. These are passed ByRef so a return
'value comes back for us to use below.
            If .Find(open_call, st_line, st_col, end_line, end_col, True, True) = False Then
 
'If not there then check if there is an on open event procedure
                If .Find("Form_Open", st_line, st_col, end_line, end_col, True, True) = True Then
 
'Add the lines if there is.
                    .InsertLines st_line + 1, vbCrLf & vbTab & open_call
 
                Else
 
'Create the event and add the lines if not.
                    op_ret = .CreateEventProc("Open", "Form")
                    .InsertLines op_ret + 1, vbCrLf & vbTab & open_call
 
                End If
 
'set the save flag
                save_flag = acSaveYes
 
            End If
 
'Clear the positioning variables
            st_line = 0
            st_col = 0
            end_line = 0
            end_col = 0
 
'Repeat for the close event.
            If .Find(close_call, st_line, st_col, end_line, end_col, True, True) = False Then
 
                If .Find("Form_Close", st_line, st_col, end_line, end_col, True, True) = True Then
 
                    .InsertLines st_line + 1, vbCrLf & vbTab & close_call
 
                Else
 
                     cl_ret = .CreateEventProc("Close", "Form")
                    .InsertLines cl_ret + 1, vbCrLf & vbTab & close_call
 
                End If
 
                save_flag = acSaveYes
 
            End If
 
            st_line = 0
            st_col = 0
            end_line = 0
            end_col = 0
 
        End With
 
    End With
 
    Set frm = Nothing
 
    DoCmd.Close acForm, Application.CurrentDb.Containers("Forms").Documents(i).Name, save_flag
 
Next i
 
End Sub

Génial !

[jpcheck]

salut,

un code interessant effectivement. Le commenter en cassoulet et expliquer le pas a pas aurait ete d'autant plus instructif pour toutes celles et ceux qui aimerait l'utiliser.