Discussion :

[Nephyline]

Bonjour,

J'ai utilisé le bout de code proposé par LedZepII dans ce sujet : Synchronisation dynamique d'un sous-formulaire et l'ai adapté pour faire la mise à jour de mon sous-formulaire (sfrm_Neolithique dont la source est la table "Neolithique") selon les valeurs saisies dans le formulaire (frm_Neolithique) dans 1. Un menu déroulant (Site_cbo) puis éventuellement 2. Une zone de texte (N°St_txt).
Pourtant, malgré la présence d'un Me.sfrm_Neolithique.Form.Requery, le sous-formulaire ne se met pas à jour, je n'obtiens aucune réponse à ma requête.

Voici le code que j'utilise :
Après la mise à jour du combo "Site_cbo"

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
Private Sub Site_cbo_AfterUpdate()
 
    'Variables
    Dim r As DAO.Recordset
    Dim SQL As String
    Dim Test As Byte
    On Error GoTo ErrorHandler
 
    'Vérification de l'existense de l'enregistrement
    SQL = "SELECT Count (*) FROM tbl_Site WHERE Site = '" & Replace(Me.Site_cbo, "'", "''") & "'"
    Set r = CurrentDb.OpenRecordset(SQL)
    Test = r.Fields(0).Value
 
    'Si l'enregistrement n'existe pas
    If IsNull(Site_cbo) Then
        DoCmd.CancelEvent
    ElseIf Test = 0 Then
        SQL = "INSERT INTO tbl_Site (Site) VALUES (Site_cbo);"
        DoCmd.RunSQL (SQL)
    End If
 
ErrorHandler:
        If DataErr = 3059 Then
            Beep
            Response = acDataErrContinue
        End If
 
    Resume Next
 
    Me.Refresh
    Me.Site_cbo.Requery
    Me.Site_cbo.SetFocus
    Me.Site_cbo.SelStart = 0
 
    sfmRefresh
 
End Sub

Après la mise à jour de la zone de txt "N°St_txt"

Code :

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

1
2
3
4
5
Private Sub N°St_txt_AfterUpdate()
 
    sfmRefresh
 
End Sub

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
Private Sub sfmRefresh()
 
Dim strCrit1 As String, strCrit2 As String
Dim strSQL As String, p As Long, strWHERE As String
 
strCrit1 = Nz(Me.Site_cbo, "")
strCrit2 = Nz(Me.N°St_txt, "")
 
' Récupérer source du sous-formulaire
strSQL = Me.sfrm_Neolithique.Form.RecordSource
 
' Si pas de SELECT alors Table ou Requête que l'on change
' en SELECT * FROM Table/Requête
If InStr(1, strSQL, "SELECT", vbTextCompare) = 0 Then
    strSQL = "SELECT * FROM " & strSQL
End If
' Si WHERE, l'enlever
p = InStr(1, strSQL, "WHERE", vbTextCompare)
If p > 1 Then
   strSQL = Left(strSQL, p - 1)
End If
' Si ; l'enlever
p = InStr(1, strSQL, ";")
If p > 1 Then
   strSQL = Left(strSQL, p - 1)
End If
 
' Construire clause WHERE
If strCrit1 <> "" Then
   If strWHERE <> "" Then strWHERE = strWHERE & " AND "
   strWHERE = strWHERE & "Site='" & strCrit1 & "'"
End If
 
If strCrit2 <> "" Then
   If strWHERE <> "" Then strWHERE = strWHERE & " AND "
   strWHERE = strWHERE & "N°St='" & strCrit2 & "'"
End If
 
' Si Critères, ajouter une clause WHERE
If strWHERE <> "" Then strSQL = strSQL & " WHERE " & strWHERE & ";"
Debug.Print strSQL
 
' Modifier source du sous-formulaire
Me.sfrm_Neolithique.Form.RecordSource = strSQL
Me.sfrm_Neolithique.Form.Requery
 
End Sub

Je ne comprends pas ce que j'ai pu oublié pour que la mise à jour ne se fasse pas. Est-ce que quelqu'un aurait une idée, s'il vous plaît ?

Merci de votre attention.

[Nephyline]

Au temps pour moi...

Mon problème venait du fait que le sous-formulaire avait des champs définis dans "Champs père" et "Champs fils".

En supprimant les valeurs et en laissant les Données champs père et champs fils vides, la requête agit tel qu'elle le doit.