Code VBA . dans la zone déroulante .. impossible de rajouterle champs

**CIRE3** · 27/03/2013, 19h44

bonjour

Je reprends une base access (trés bien) et je voudrais l'améliorer mais je n'arrive pas à rajouter des champs dans le formulaire dans T_Agence du genre ADV , Nom_reception etc ..

Il n'y a pourtant que quelques codes . Je l'ai modifié mais toujours pas possible !!! le formulaire est peut bloqué ? et dans la zone déroulante , il n' y a que Département, Nom_Agence,N_Société, Num_Departement_etiquette, Save-Agence, Ville

Pouvez vous m'aider les experts en codes ?

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
 
Public Function New_Société(Nom_Société As String) As Boolean
 
Dim Rs0 As DAO.Recordset
 
Set Rs0 = CurrentDb.OpenRecordset("Select * from T_Société where Nom_Société = """ & Nom_Société & """ ;")
 
If Rs0.AbsolutePosition = -1 Then
    'Création de la société
    DoCmd.RunSQL ("Insert into T_Société(Nom_Société) values('" & Nom_Société & "') ;")
    MsgBox "Société """ & Nom_Société & """ créée !"
    New_Société = True
Else
    MsgBox "La société """ & Nom_Société & """ existe déjà !"
    New_Société = False
End If
 
End Function
 
Public Function New_Agence(Nom_Agence As String, Num_Département As String, Ville As String, ID_Société As Integer) As Boolean
 
Dim Rs0 As DAO.Recordset
 
Set Rs0 = CurrentDb.OpenRecordset("Select * from T_Agence where Nom_Agence = """ & Nom_Agence & """ and ID_Société = " & ID_Société & " ;")
 
'Vérifie que l'agence n'existe pas déjà
If Rs0.AbsolutePosition = -1 Then
    'Création de l'agence
    DoCmd.RunSQL ("Insert into T_Agence(Nom_Agence, Département, Ville, ID_Société) values('" & Nom_Agence & "', '" & Num_Département & "', '" & Ville & "', " & ID_Société & ") ;")
    MsgBox "Agence """ & Nom_Agence & """ créée !"
    New_Agence = True
Else
    MsgBox "L'agence """ & Nom_Agence & """ existe déjà pour cette société !"
    New_Agence = False
End If
 
End Function
 
Public Function Nouveau_Contact(Prénom As String, NOM As String, MAIL As String, ID_Agence As Integer, Optional Tel As String, Optional FAX As String) As Boolean
                    '********* La fonction renvoie "True" si la création s'est bien effectuée ****************'
 
Dim Rs0 As DAO.Recordset
 
Set Rs0 = CurrentDb.OpenRecordset("Select * from T_Contact where Nom_Contact = """ & NOM & """ and Prénom_Contact = """ & Prénom & """ and ID_Agence = " & ID_Agence & " ;")
 
'Vérifie que le contact n'existe pas déjà
If Rs0.AbsolutePosition = -1 Then
    'Création du contact
    DoCmd.RunSQL ("Insert into T_Contact(Nom_Contact, Prénom_Contact, Tel_Contact, Fax_Contact, Mail_Contact, Id_Agence) values('" & NOM & "', '" & Prénom & "', '" & Tel & "', '" & FAX & "', '" & MAIL & "', " & ID_Agence & ") ;")
    MsgBox "Contact """ & NOM & """ créée !"
    Nouveau_Contact = True
Else
    MsgBox "Le contact """ & NOM & " " & Prénom & """ existe déjà !"
    Nouveau_Contact = False
End If
 
End Function

**CIRE3** · 27/03/2013, 19h45

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
Private Sub Form_Open(Cancel As Integer)
 
DoCmd.Maximize
 
End Sub
 
 
Private Sub Save_Agence_Click()
 
Dim Rs0 As DAO.Recordset
Dim Rs1 As DAO.Recordset
Dim stDocName As String
Dim stLinkCriteria As String
Dim Nouvelle_Agence As String
Dim Nom_Société As String
Dim ID_Société As Integer
Dim New_département As String
Dim New_Ville As String
Dim Effectué As Boolean
 
If Me.Nom_Agence <> "" And Me.Département <> "" And Me.Ville <> "" Then
 
    'Récupération de l'ID de la société séléctionné
    Set Rs0 = CurrentDb.OpenRecordset("Select * from T_Société where Nom_Société = """ & Me.Nom_Société & """ ;")
    ID_Société = Rs0.Fields![ID_Société]
    New_département = Me.Département
    New_Ville = Me.Ville
    Nouvelle_Agence = Me.Nom_Agence
    Nom_Société = Me.Nom_Société
    Set Rs0 = CurrentDb.OpenRecordset("Select * from T_Agence where Nom_Agence = """ & Me.Nom_Agence & """ ;")
 
    'Récupération du numéro du département à partir du nom
    Set Rs1 = CurrentDb.OpenRecordset("Select * from T_Département where Nom_Département = """ & Me.Département & """ ;")
 
    Effectué = New_Agence(Me.Nom_Agence, Rs1.Fields![Num_Département], Me.Ville, ID_Société)
 
    If Effectué = True Then
        'Fermeture du formulaire création Agence
        DoCmd.Close
        stDocName = "New_Contact"
        DoCmd.OpenForm stDocName, , , stLinkCriteria
 
        'Activation et MAJ des champs du formulaire de création de contact
        Forms![New_Contact].Nom_Société = Nom_Société
        Forms![New_Contact].Nom_Agence = Nouvelle_Agence
        Forms![New_Contact].Département = New_département
        Forms![New_Contact].Ville = New_Ville
        Forms![New_Contact].Nom_Contact.Locked = False
        Forms![New_Contact].Prénom_Contact.Locked = False
        Forms![New_Contact].Tel_Contact.Locked = False
        Forms![New_Contact].Fax_Contact.Locked = False
        Forms![New_Contact].Mail_Contact.Locked = False
 
        'Activation des Champs Section Agence
        Forms![New_Contact].Département.Locked = False
        Forms![New_Contact].Ville.Locked = False
        Forms![New_Contact].Nom_Agence.Locked = False
 
 
        'Activation bouton Ajout Agence et Contact
        Forms![New_Contact].New_Agence.Enabled = True
        Forms![New_Contact].New_Contact.Enabled = True
 
        'Changement de couleur de fond des 5 champs "Contact" du formulaire de créaion de contact
        Forms![New_Contact].Nom_Contact.BackColor = 16777215        'Couleur Blanc
        Forms![New_Contact].Prénom_Contact.BackColor = 16777215     'Couleur Blanc
        Forms![New_Contact].Tel_Contact.BackColor = 16777215        'Couleur Blanc
        Forms![New_Contact].Fax_Contact.BackColor = 16777215        'Couleur Blanc
        Forms![New_Contact].Mail_Contact.BackColor = 16777215       'Couleur Blanc
 
        'Changement couleur de fond des Champ Agence
        Forms![New_Contact].Département.BackColor = 16777215
        Forms![New_Contact].Ville.BackColor = 16777215
        Forms![New_Contact].Nom_Agence.BackColor = 16777215
 
    Else
        Me.Nom_Société = Nom_Société
    End If
Else
    MsgBox "Veuillez saisir un nom d'agence avant d'enregistrer"
End If
 
End Sub

**CIRE3** · 27/03/2013, 19h51

4 tables dans la base

T_Agence
T_Contact
T_Département
T_Société

1 seule requête

SELECT T_Contact.Nom_Contact AS NOM, T_Contact.Prénom_Contact AS PRENOM, T_Contact.Tel_Contact AS TELEPHONE, T_Contact.Fax_Contact AS FAX, T_Contact.Mail_Contact AS MAIL, T_Département.Nom_Département, T_Agence.ID_Agence, T_Agence.ID_Société, T_Société.Nom_Société, T_Agence.Nom_Agence, T_Contact.ID_Contact AS ID_Contact, T_Agence.rdv_fixe, T_Agence.ouvert_agene, T_Agence.nom_recption, T_Agence.adv, T_Agence.commentaires
FROM T_Société INNER JOIN (T_Département INNER JOIN (T_Agence INNER JOIN T_Contact ON T_Agence.ID_Agence = T_Contact.ID_Agence) ON T_Département.Num_Département = T_Agence.Département) ON T_Société.ID_Société = T_Agence.ID_Société;

**CIRE3** · 29/03/2013, 13h32

ok réussi une trés gros bonne partie
y a du code sur tout les formulaires et modules

Code VBA . dans la zone déroulante .. impossible de rajouterle champs [AC-2003]

IHM

Discussions similaires

Partager

Partager