Discussion :

[Aleks_HL]

Bonjour les amis,

Je fais présentement face à un problème, que voici; j'ai écris un code VBA pour intégrer de nouvelles entrés provenant d'un formulaire à quatre base de données différentes, que voici:
Table_des_polygones,
Table_forage,
Table_Sautage,
Table_notes;

Le bouton enregistrer doit vérifier si l'entré existe déjà à l'aide de méthode Findfirst, puis enregistrer les valeurs dans la base de données.

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
 
Private Sub enregistrer_Click()
    '   Déclaration pour les différentes base de données soit (Forage, Sautage et Notes)
    Dim db_forage As DAO.Database
    Dim db_sautage As DAO.Database
    Dim db_Notes As DAO.Database
    Dim db_polygones As DAO.Database
 
    '   Déclaration des requetes pour chacune des base de données
    Dim rs_forage As DAO.Recordset
    Dim rs_Sautage As DAO.Recordset
    Dim rs_Notes As DAO.Recordset
    Dim rs_polygone As DAO.Recordset
 
    Set db = CurrentDb
    '   Ouvrir les tables de données pour integrer les données
    Set rs_forage = db.OpenRecordset("Table_Forage")
    Set rs_Sautage = db.OpenRecordset("Table_Sautage")
    Set rs_Notes = db.OpenRecordset("Table_Notes")
    Set rs_polygone = db.OpenRecordset("Table_des_polygones")
 
    '   Entrer les données dans la base de données de polygone
    '   Recherche si l'entré existe déjà
    rs_polygone.FindFirst "[No_Sautage] = #" & Me.No_Sautage & "#"
    If rs_polygone.NoMatch Then
        With rs_polygone
            .AddNew
            ![No_Sautage] = Me![No_Sautage]
            ![Date_approx] = Me![Date_approx]
            .Update
            .Close
        End With
    Else
        '   Si l'entré existe deja, on ne l'ajoute pas, mais on ne dit rien puisque ça
        '   n'altere pas le bon fonctionnement de l'application.
        Set rs_polygone = Nothing
    End If
 
    '   Entrer les données dans la base de données de forage
    '   Recherche si l'entré existe deja
    rs_forage.FindFirst "[No_Trou] = #" & Me.No_Trou & "#"
    If rs_forage.NoMatch Then
        With rs_forage
            .AddNew
            ![No_Sautage] = Me![No_Sautage]
            ![No_Trou] = Me![No_Trou]
            ![L_plannifier] = Me![L_plannifier]
            ![L_foree] = Me![L_foree]
            ![conf_L_foree] = Me![conf_L_foree]
            ![reforage_demander] = Me![reforage_demander]
            ![L_ajuste] = Me![L_ajuste]
            ![conf_L_ajuste] = Me![conf_L_ajuste]
            .Update
            .Close
        End With
    Else
        '   Si l'entré existe déjà, Bin on l'ajoute PAS!!!
        MsgBox "L'entré existe déjà!"
        Set rs_forage = Nothing
    End If
    Set rs_forage = Nothing
 
    '   Entrer les données dans la base de données de sautage
    '   Recherche si l'entré existe deja
    rs.FindFirst "[No_Trou] = #" & Me.No_Trou & "#"
    If rs_Sautage.NoMatchmatch Then
        With rs_Sautage
            .AddNew
            ![No_Sautage] = Me![No_Sautage]
            ![No_Trou] = Me![No_Trou]
            ![Nb_amorce] = Me![Nb_amorce]
            ![conf_Pos_Amorce] = Me![conf_Pos_Amorce]
            ![L_av_gazing] = Me![L_av_gazing]
            ![L_ap_gazing] = Me![L_ap_gazing]
            ![conf_granulo] = Me![conf_granulo]
            ![L_bourrage] = Me![L_bourrage]
            ![conf_L_bourrage] = Me![conf_L_bourrage]
            .Update
            .Close
        End With
    Else
        '   Si l'entré existe déjà, bin on l'ajoute PAS!!
        MsgBox "L'entré existe déjà!"
        Set rs_Sautage = Nothing
    End If
    Set rs_Sautage = Nothing
 
    '   Entrer les données dans la base de données des de notes
    '   Recherche si l'entré existe deja
    rs_Notes.FindFirst "[No_Trou] = #" & Me.No_Trou & "#"
    If rs_Notes.NoMatchmatch Then
        With rs_Notes
            .AddNew
            ![No_Sautage] = Me![No_Sautage]
            ![No_Trou] = Me![No_Trou]
            ![Type_Recouvrement] = Me![Type_Recouvrement]
            ![conf_recouvrement] = Me![conf_recouvrement]
            ![Notes_A] = Me![Notes_A]
            ![Notes_B] = Me![Notes_B]
            ![Notes_C] = Me![Notes_C]
            ![Notes_D] = Me![Notes_D]
            ![Notes_E] = Me![Notes_E]
            ![Notes_F] = Me![Notes_F]
            ![Notes_G] = Me![Notes_G]
            ![Notes_H] = Me![Notes_H]
            ![Notes_I] = Me![Notes_I]
            ![Notes_J] = Me![Notes_J]
            ![Notes_K] = Me![Notes_K]
            ![Notes_L] = Me![Notes_L]
            ![Notes_M] = Me![Notes_M]
            ![Notes_N] = Me![Notes_N]
            ![Notes_O] = Me![Notes_O]
            ![Notes_P] = Me![Notes_P]
            ![Notes_Q] = Me![Notes_Q]
            ![Notes_R] = Me![Notes_R]
            .Update
            .Close
        End With
    Else
        '   Bin si l'entré existe déjà on l'ajoute PAS!!
        MsgBox "L'entré existe déjà!!"
        Set rs_Notes = Nothing
    End If
    Set rs_Notes = Nothing
 
    '   Resetter les champs
    Dim X As Control
    For Each X In Me.Controls
        If TypeOf X Is TextBox Then
            X = Null
        End If
    Next X
 
 
End Sub

Cependant, lorsque j'appui sur le bouton, aucune entré ne s'ajoute à ma base de donnée.

Est-ce que vous avez une idées pourquoi il ne répond pas? Juste me donner une piste,

Merci beaucoup!!
Aleks

[User]

Bonjour,

Si le champ "No_Sautage" contient des valeurs alphanumériques (texte), alors il faut mettre des quotes (') de part et d'autre...

Code :

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

rs_polygone.FindFirst "[No_Sautage] = '" & Me.No_Sautage & "'"

Même chose pour le reste ...

A+

Denis

[Aleks_HL]

Merci pour la réponse,

Je viens de corriger les lignes concernés.

Je me suis un peu informer sur le sujet et j'ai lu un peu sur d'autre forum et une remarque mentionne que pour utiliser findfirst avec une table, il faut que j'ouvre mon recordset avec l'attribue dbopenDynaset

Code :

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

1
2
 
Set rs_polygone = db.OpenRecordset("Table_des_polygones", dbOpenDynaset)

Est-ce obligatoire, est-ce que ça ferait en sorte que mon boutton enregistrer active le code?
Parce que présentement, même avec la modification apporter, il se passe rien quand j'appuie sur le bouton.

Merci,
Aleks

[marot_r]

Le dbopenDynaset est obligatoire pour le findfirst sur une table locale mais à priori cela n'a aucun lien avec l'éxécution de ton code.

• Vérifie que les macros sont bien activées dans ta BD.
• Vérifie que dans l'événement sur click de ton bouton, Access affiche bien "procédure événementielle".
• Mets un point d'arrêt au début de ton code (clique dans la marge à gauche) et valide que le code n'est vraiment pas éxécuté.

A+

[User]

Salut,

En complément du post de Marot,

As-tu essayé de créer les recordset en double:

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
Set rs_forage = db.OpenRecordset("Table_Forage")
Set tb_forage = db.OpenRecordset("Table_Forage")
 
...
 
rs_polygone.FindFirst "[No_Sautage] = '" & Me.No_Sautage & "'"
    If rs_polygone.NoMatch Then
        With tb_polygone
            .AddNew
            ![No_Sautage] = Me![No_Sautage]
            ![Date_approx] = Me![Date_approx]
            .Update
            .Close
        End With
    Else

Un pour le filtrage et 1 pour l'ajout

Sans garantie

D'autre part, es-tu sûr qu'il n'y a pas déjà ce NO_Sautage dans la table "Table_Forage" ?

A+

[Aleks_HL]

Merci pour toute ces réponses, véritablement, ce qui ne fonctionnait pas c'était simplement que le bouton n'était pas en mode procédure évenementiel.

Merci beaucoup pour toute ces réponses, maintenant il ne me reste qu'à finaliser les doublechecks et je vais avoir fini la grosse partie VBA qui ne m'étais que très peu famillière, merci guys!!!