Modifier une procédure événementielle via VBA

**Tazzou** · 06/11/2017, 22h02

Salut à vous

J'ai cette procédure événementielle :

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
Private sub Form_Open(Cancel as Integer)
 
Demarrer
Me.ShortcutMenu = False
 
DoCmd.GoToRecord , , acFirst
If IsNull(Me.DateUtilisation) Then
   Me.DateUtilisation = Date
Else
   If DateDiff("d", Me.DateUtilisation, Now()) > 30 Then
      MsgBox "Votre période d'essai est terminée." & vbNewLine & "Toutes les fonctions sont désactivées." & vbNewLine & "Contactez votre développeur pour débloquer cette base.", _
             vbOKOnly + vbExclamation, "Gestion des heures de travail"
             GoTo Accueil_Verrouille
   Else
      Exit Sub
   End If
End If
 
Accueil_Verrouille:
Me.GestionHeures_SaisieHeures.Enabled = False
Me.GestionHeures_Recapitulatif.Enabled = False
Me.GestionHeures_PErsonnel.Enabled = False
Me.GestionHeures_Deverrouiller.Visible = True
 
End sub

et je souhaiterai supprimer les lignes 6 à 23 via VBA

Pourriez-vous m'orienter sur la façon de faire ??? SVP Merci beaucoup

**marot_r** · 06/11/2017, 22h29

Bonjour.

C'est possible mais pas forcément simple.

Ici un post sur le sujet :
Deconstruction of a VBA Code Module
https://www.codeproject.com/Articles...BA-Code-Module

A+

**marot_r** · 06/11/2017, 22h32

Et il est possible que ton anti-virus sonne l'alerte car du code qui modifie du code c'est typique des virus.

A+

**Tazzou** · 06/11/2017, 23h05

Pour le moment aucune activité de l'antivirus en ce sens.
C'est juste que je ne trouve pas comment faire.
A moins qu'il existe un moyen de supprimer carrément la procédure et d'en attribuer une autre

**Tazzou** · 07/11/2017, 19h00

J'ai trouvé !!!!

j'ai utilise la commande mdl.deleteline et ca fonctionne comme je le veux SAUF que lors de l'ouverture du formulaire j'ai ce message Nom : Sans titre.jpg
Affichages : 821
Taille : 107,3 Ko

Nom : Sans titre.jpg
Affichages : 821
Taille : 107,3 Ko

Pourriez-vous m'aider ???

**tee_grandbois** · 08/11/2017, 11h03

Bonjour,

et je souhaiterai supprimer les lignes 6 à 23 via VBA

sais-tu que l'éditeur VBA fonctionne comme un éditeur de texte ? il suffit de sélectionner le texte en le surlignant et en appuyant sur Suppr.

ca fonctionne comme je le veux SAUF que lors de l'ouverture du formulaire j'ai ce message

une fois supprimé, le code ne reviendra plus donc je pense que tu supprimes le code restant à chaque ouverture de ton formulaire et bien sûr, cela doit créer des erreurs car la ligne 6 du nouveau code, c'est le End Sub et puis après ce sont les autres procédures ...
J'espère que tu as une sauvegarde de ta base car il va falloir remettre le code supprimé.

**Tazzou** · 09/11/2017, 17h16

sais-tu que l'éditeur VBA fonctionne comme un éditeur de texte ? il suffit de sélectionner le texte en le surlignant et en appuyant sur Suppr.

Je sais bien que ça fonctionne comme un éditeur de texte mais je veux que l'utilisateur de la base supprime ces lignes en cliquant sur un bouton (bouton qui disparait suite à l'opération)

Grace à ce code :

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
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   DoCmd.Close , , acSaveYes
   DoCmd.RunSQL "DELETE T_Utilisation.* FROM T_Utilisation"
 
   Dim F1 As String
 
   F1 = "F_Accueil"
   DoCmd.OpenForm F1, acDesign, , , , acHidden
   DeleteControl "F_Accueil", "DateUtilisation"
   DeleteControl "F_Accueil", "GestionHeures_Deverrouiller"
 
   Dim MDL As Module
   Dim LNG As Long
 
   Set MDL = Forms(F1).Module
   MDL.DeleteLines 3, 29
   Forms(F1).OnOpen = ""
   Forms(F1).OnOpen = "[Event procedure]"
   lngreturn = MDL.CreateEventProc("Open", "Form")
   MDL.InsertLines lngreturn + 2, "Demarrer"
 
   A = "DoCmd.ShowToolbar "
   B = A & """"
   C = B & "Ribbon"
   D = C & """"
   E = D & ", acToolbarNo"
 
   MDL.InsertLines lngreturn + 3, E
   MDL.InsertLines lngreturn + 4, "'Me.ShortcutMenu = False"
   MDL.InsertLines lngreturn + 5, "SetWarnings = False"
 
   ClickEventProc = False
   Set MDL = Nothing
 
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   Ouvrir "F_Accueil"

Je supprime toute la procédure OnOpen du formulaire F_Accueil et je réattribue une nouvelle procédure. Tout se passe bien jusqu'au clic sur un bouton du formulaire qui laisse apparaître le message en image jointe au message plus haut.

Tout le code est correct mais ça ne fonctionne pas et je ne comprend pas où est le problème... Pourriez-vous m'aider s'il vous please ???

**Thierry_PALLIER** · 09/11/2017, 17h54

Bonsoir le forum.

@ Tazzou, il y a une réponse ici :https://www.developpez.net/forums/d5...eateeventproc/

Envoyé par psykodumarteau

j'ai enfin réussi à résoudre mon problème. En fait pour mettre un évènement sur l'ouverture d'un formulaire, il n'y a pas besoin d'utiliser la méthode CreateEventProc. Il suffit juste d'écrire la fonction "form_open" dans le module du formulaire. Voici mon code :

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
 
'ouvre le formulaire model, le copie et le referme
DoCmd.OpenForm "BRDC_VIERGE", acNormal, , , , acHidden
DoCmd.CopyObject , nomformcible, acForm, "BRDC_VIERGE"
DoCmd.Close acForm, "BRDC_VIERGE", acSaveNo
 
 
'attribu la requete dynamique au formulaire dynamique
DoCmd.OpenForm nomformcible, acDesign, , , acFormReadOnly
'Forms.Item(nomformcible).RecordSource = nomreqcible2
Set newform = Forms.Item(nomformcible)
newform.RecordSource = nomreqcible2
 
'Créer un module d'événement pour le nouveau formulaire
newform.HasModule = True
Set mdlevent = newform.Module
 
 
'lgnreturn = mdlevent.CreateEventProc("Click", newform.BtnDetails.Name)
'MsgBox CodeOuvertureNewForm
mdlevent.InsertLines 4, CodeOuvertureNewForm

et la déclaration de la constante CodeOuvertureNewForm

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
 
Public Const CodeOuvertureNewForm As String = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf & _
                                              " Dim rcs As DAO.Recordset" & vbCrLf & _
                                              " Set rcs = Me.Recordset" & vbCrLf & _
                                              " Me.TxtTYPE.ControlSource = rcs.Fields(""CODE_LIG"").Name" & vbCrLf & _
                                              " Me.TxtCLIENT.ControlSource = rcs.Fields(""CLIENT"").Name" & vbCrLf & _
                                              " Me.TxtREFERENCE.ControlSource = rcs.Fields(""REFERENCE"").Name" & vbCrLf & _
                                              " Me.TxtDESIGNATION.ControlSource = rcs.Fields(""DESIGNATION"").Name" & vbCrLf & _
                                              " Me.TxtARTICLE.ControlSource = rcs.Fields(""ARTICLE"").Name" & vbCrLf & _
                                              " Me.TxtDATE.ControlSource = rcs.Fields(""DATE"").Name" & vbCrLf & _
                                              " Me.TxtQTE_BESOIN.ControlSource = rcs.Fields(""QTE_BES"").Name" & vbCrLf & _
                                              " Me.TxtQTE_RESSOURCE.ControlSource = rcs.Fields(""QTE_RES"").Name" & vbCrLf & _
                                              " Me.TxtCODE.ControlSource = rcs.Fields(""CODE_ORIGINE"").Name" & vbCrLf & _
                                              " Me.TxtORIGINE.ControlSource = rcs.Fields(""ORIGINE"").Name" & vbCrLf & _
                                              " Me.TxtREF_ORIGINE.ControlSource = rcs.Fields(""REF_ORIG"").Name" & vbCrLf & _
                                              " Me.TxtART_ORIG.ControlSource = rcs.Fields(""ART_ORIG"").Name" & vbCrLf & _
                                              " Me.TxtDATE_LANC.ControlSource = rcs.Fields(""DATE_LANCEMENT_PREV"").Name" & vbCrLf & _
                                              " Set rcs = Nothing" & vbCrLf & _
                                              "end sub"

Si ça peut servir à quelqu'un.

Cordialement

Cdlt

**Tazzou** · 10/11/2017, 20h17

@Thierry_PALLIER, j'ai bien tenu compte de ton lien

Voici comment j'ai modifié :

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
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   DoCmd.Close , , acSaveYes
   DoCmd.RunSQL "DELETE T_Utilisation.* FROM T_Utilisation"
 
   DoCmd.OpenForm "F_Accueil", acDesign, , , , acHidden
   DeleteControl "F_Accueil", "DateUtilisation"
   DeleteControl "F_Accueil", "GestionHeures_Deverrouiller"
 
   Forms("F_Accueil").OnOpen = ""
 
   Forms("F_Accueil").Module.DeleteLines 3, 34
 
   A = "DoCmd.showToolbar " & """" & "Ribbon" & """" & ", acToolBarNo"
   PhraseDeProg = "Private sub Form_Load()" & vbCrLf & vbCrLf & "Demarrer" & vbCrLf & A & vbCrLf & "SetWarnings = False" & vbCrLf & "'Me.ShortcutMenu = False" & vbCrLf & vbCrLf & "End sub"
 
   Forms("F_Accueil").Module.InsertLines 3, PhraseDeProg
 
   Forms("F_Accueil").OnLoad = "[Event procedure]"
 
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   Ouvrir "F_Accueil"

MAIS, parce qu'il y en a encore un

, ça a fonctionné correctement 1 fois (procedure OnOpen du form et OnClick des boutons)

la procédure que je veux supprimer s'est bien supprimée, la procédure que je veux ajouter s'est bien ajoutée mais après toujours le même message

**Thierry_PALLIER** · 11/11/2017, 17h43

Bonsoir Tazzou.

Attention, le formulaire ou le code qui s'y trouve ne doivent pas être en cours d'exécution.

Cet exemple ,un pe générique et réutilisable fonctionne chez moi:

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
Option Compare Database
Option Explicit
 
Public Const CodeOuvertureNewForm As String = "Private Sub Form_Open(Cancel As Integer)" & vbCrLf & _
     " If SysCmd(acSysCmdAccessVer) = ""11.0"" Then" & vbCrLf & _
     " Set MouseHook = NewMouseHook(Me)" & vbCrLf & _
     " MouseHook.Scroll = False" & vbCrLf & _
     " End If" & vbCrLf & _
       "End Sub"
 
 
 
Sub SuprCreat_EventSuB(NomFormCible As String, NomProc As String)
    Dim Vbc As VBComponent
    Dim mdl As Module
 
    DoCmd.OpenForm NomFormCible, acDesign, , , acFormReadOnly
    DoCmd.OpenModule "Form_" & NomFormCible, NomProc
 
    Set mdl = Modules("Form_" & NomFormCible)
    mdl.DeleteLines 7, 10 + 1 'la dernière ligne+1
 
    mdl.InsertLines 4, CodeOuvertureNewForm
    DoCmd.Save acForm, NomFormCible
 
 
    RunCommand acCmdCompileAndSaveAllModules
    DoCmd.Close acForm, NomFormCible, acSaveYes
 
End Sub
Sub gggggg()
Call SuprCreat_EventSuB("Apave_Controle", "Form_Open")
End Sub

J' y supprime tout un module, et j'en copie un autre.
A adapter.
Cdlt

**Tazzou** · 12/11/2017, 15h17

Merci beaucoup de ton aide.

Voici comment j'ai adapté ton code:

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
   Dim Phrase_Code As String
   Phrase_Code = "Private sub Form_Load()" & vbCrLf & _
               vbCrLf & _
               "Demarrer" & vbCrLf & _
               "'Me.ShortcutMenu = False" & vbCrLf & _
               "DoCmd.ShowToolbar ""Ribbon"", acToolbarNo" & vbCrLf & _
               "SetWarnings = False" & vbCrLf & _
               vbCrLf & _
               "End sub"
 
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   DoCmd.OpenForm "F_Accueil", acDesign
   Dim MDL As Module
   DoCmd.OpenModule "Form_F_Accueil", "Form_Open"
   Set MDL = Modules("Form_F_Accueil")
   MDL.DeleteLines 3, 33
   MDL.InsertLines 3, Phrase_Code
   DoCmd.Save acForm, "F_Accueil"
   RunCommand acCmdCompileAndSaveAllModules
   Forms("F_Accueil").OnOpen = ""
   Forms("F_Accueil").OnLoad = "[Event Procedure]"
   Application.VBE.MainWindow.Visible = False
   DoCmd.Close acForm, "F_Accueil", acSaveYes
   Ouvrir "F_Accueil"

Cela fonctionne super bien !!!

Encore merci !!!

Modifier une procédure événementielle via VBA

VBA Access

Discussions similaires

Partager

Partager