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 |
Partager