ACCESS Filtre formulaire sur Inconsistent DAO RECORDSET

Question

Bonjour à tous,

Je suis face à un problème de mise à jour de champ dans un formulaire après application d'un filtre.

Voici l'exemple qui met en avant mon problème.

Dans une base ACCESS 2007, j'ai deux tables :
T1
Champ : id1; Type : Numerique (clé primaire)
Champ : Description; Type : Texte
Champ : id2Long; Type : Texte (Ce champ contien un caractère quelconque suivi de l'identifiant de la table T2 sur 1 caractère)

Jeux de données exemple
1;"Toto";"AP"
2;"Tata";"AQ"
3;"Tutu";""

T2
Camp : id2; Type : Texte (Clé primaire)
Champ : Description; Type : Texte

Jeux de données exemple
"P";"Pomme"
"Q";"Poire"

Et une requête :
R1
SELECT T1.id1, T1.Description as Description1, T2.Description as Description2
FROM T1 LEFT JOIN T2 ON Right(T1.id2Long, 1) = T2.id2

Mon besoin est d'afficher la requête R1 avec des controls TexBox dans un formulaire et de pouvoir modifier le champs Description1 (Qui nécessite un formulaire avec recordset de type "Feuille rép.dyn.(MAJ globale)" à cause de la jointure)

Par nécessité, la liaison aux données doit se faire par affectation du recordest du formulaire. De cette manière :
Private Sub Form_Load()
    Set Me.Recordset = CurrentDb.OpenRecordset("SELECT * FROM R1", dbOpenDynaset, dbInconsistent)
End Sub

Les parmètres dbOpenDynaset et dbInconsistent me permettent justement de pouvoir modifier Description1 malgré la jointure.

Jusqu'ici tout va bien, le chemp peut être mis à jour. Par contre si j'applique un filtre au formulaire, par exemple :
Private Sub Cmd_Filtre_Click()
   Me.Filter = "[Description2]='Pomme'"
   Me.FilterOn = True
End Sub
Le champ Description1 ne peut plus être modifié.

D'ailleurs, on remarque que la propriété Me.Recordset.Updatable est passé de True à False àpres l'application du filtre.

Connaissez vous une solution pour résoudre ce problème ?

Ma seule piste est que, normalement, pour filtrer un recordset dao Inconsistent il faudrait faire ceci :
Dim rs as DAO.Recordset
Dim rsFiltre as DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM R1", dbOpenDynaset, dbInconsistent)
rs.Filter "[Description2] 'Pomme'"
Set rsFiltre = rs.OpenRecordset(dbOpenDynaset, dbInconsistent)

Et on dirait que, malheureusement, ACCESS omet les paramètres dbOpenDynaset et dbInconsistent lors de l'application du filtre de formulaire.

Merci d'avance.

dofrancis3 · Answer

Allo la Terre et  bonjour à  tous je fais appel  à vous  aider moi SVP mon problème  est celui-ci:
je souhaite lier mon formulaire à une requête (table) Access 2010
située sur un serveur distant (Sql Server) via ADO. Le problème c'est que je 
ne trouve nul part la procédure à appliquer et le code. Mon code ressemble à 
ceci:

Option Compare Database
Option Explicit
' Variables à modifier
Dim expressionET(1 To 4)  ' A dimensionner selon le nombre maximum de critères
Dim expressionOU(1 To 4)  ' A dimensionner selon le nombre maximum de critères
Const vSource = "Liste_MontantTotal_des_Contrats" ' Nom de la table ou requête source du formulaire de recherche
Private Sub Btn_RAZ_Click()
CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " & vSource & " WHERE false"
Me![SF_FiltreMTC].Form.RecordSource = "filtre"
'Me.Lbl_SQL.Caption = ""
Me.ListeDesChamps1 = Null
Me.ListeDesChamps2 = Null
Me.ListeDesChamps3 = Null
Me.ListeDesChamps4 = Null
Me.CritèreDuChamp1 = Null
Me.CritèreDuChamp2 = Null
Me.CritèreDuChamp3 = Null
Me.CritèreDuChamp4 = Null
Me.CritèreOUChamp1 = Null
Me.CritèreOUChamp2 = Null
Me.CritèreOUChamp3 = Null
Me.CritèreOUChamp4 = Null
End Sub





Private Sub ExécuteLaRecherche_Click()
 Dim MonSQL As String, MonCritère As String
Dim Marequête As DAO.QueryDef
 Dim TypeChamp
Dim I
 Dim nbExpressionET, nbExpressionOU
On Error Resume Next
'Me.Lbl_SQL.Caption = ""
'Lire les critères "ET"
I = 1
Do While Len(Me("CritèreDuChamp" & I)) > 0
expressionET(I) = "(" &BuildCriteria(Me("ListeDesChamps" & I).Column(1), _
Me("ListeDesChamps" & I).Column(2), Nz(Me("CritèreDuChamp" & I), "null")) & ")"
    I = I + 1
Loop
nbExpressionET = I - 1
'Lire les critères "OU"
I = 1
Do While Len(Me("CritèreOUChamp" & I)) > 0
expressionOU(I) = "(" &BuildCriteria(Me("ListeDesChamps" & I).Column(1), _
Me("ListeDesChamps" & I).Column(2), Nz(Me("CritèreOUChamp" & I), "null")) & ")"
    I = I + 1
Loop
nbExpressionOU = I - 1
' Efface la requête par mesure de sécurité, afin de ne pas supprimer une ancienne recherche
CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " &vSource& " WHERE false"
'  Initialisel'instruction SELECT
MonSQL = "SELECT * FROM " &vSource&" WHERE "
    If nbExpressionET 0 Then MonSQL Left(MonSQL, Len(MonSQL) - 6)
    Select Case nbExpressionET
        Case 1
MonSQL = MonSQL&expressionET(1)
        Case Is > 1
MonSQL = MonSQL& "("
            For I = 1 TonbExpressionET
MonSQL = MonSQL&expressionET(I) & " AND "
            Next
MonSQL = Left(MonSQL, Len(MonSQL) - 5) ' Enlever le dernier " AND "
MonSQL = MonSQL& ")"
    End Select
        Select Case nbExpressionOU
        Case 1
MonSQL = MonSQL& " OR (" &expressionOU(1) & ")"
        Case Is > 1
MonSQL = MonSQL& " OR (" &expressionOU(1) & " AND "
            For I = 2 TonbExpressionOU
MonSQL = MonSQL&expressionOU(I) & " And "
Next
MonSQL = Left(MonSQL, Len(MonSQL) - 5) ' Enlever le dernier " AND "
MonSQL = MonSQL& ")"
    End Select
        '  Défini la propriété RecordSource du filtre.
If IsNull(Me.ListeDesChamps1) = 0 Then
MonSQL = MonSQL&" ORDER BY " & Me.ListeDesChamps1.Column(1)
    Else
    End If
CurrentDb.QueryDefs("Filtre").SQL = MonSQL
Me![SF_FiltreMTC].Form.RecordSource = Filtre
  '  Si aucun enregistrement ne correspond aux critères, affiche un message.
   '  Active le bouton Effacer.
If Me![SF_FiltreMTC].Form.RecordsetClone.RecordCount = 0 Then
MsgBox "Aucun enregistrement trouvé", 48, "Recherche"
'Me!Effacer.SetFocus
    End If
End Sub
Private Sub cmd_Export_Click()
    Dim xlApp As Excel.Application
    Dim xlSheet As Excel.Worksheet
    Dim xlBook As Excel.Workbook
    Dim I As Long, J As Long
Dim t0 As Long, t1 As Long
   t0 = Timer
Dim rec As Recordset
    Set rec = CurrentDb.OpenRecordset("Filtre", dbOpenSnapshot)
    'Initialisations
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
'Ajouter une feuille de calcul
    Set xlSheet = xlBook.Worksheets.Add
xlSheet.Name = "Tutoriel"
               ' le titre
    '  écriture dans la cellule de ligne 1 et de colonne 1
xlSheet.Cells(1, 1) = "Export d'une table Access"
     ' lesentetes
    '  .Fields(Index).Name renvoie le nom du champ
For J = 0 Torec.Fields.Count - 1
xlSheet.Cells(2, J + 1) = rec.Fields(J).Name
' Nous appliquons des enrichissements de format aux cellules
With xlSheet.Cells(2, J + 1)
            .Interior.ColorIndex = 15
            .Interior.Pattern = xlSolid
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).Weight = xlThin
            .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
            .HorizontalAlignment = xlCenter
        End With
    Next J
' recopie des données à partir de la ligne 3
I = 3
    Do While Not rec.EOF
        For J = 0 Torec.Fields.Count - 1
' .Fields(Index).Type renvoie le type du champ
            '   si c'est un Texte (dbText) nous insérons "'" pour
            '   qu'il soit reconnu par Excel comme du Texte
If rec.Fields(J).Type = dbText Then
xlSheet.Cells(I, J + 1) = "'" &rec.Fields(J)
Else                                                     '-----> j'ai un message d'erreur (erreur 1004 = erreur defini par l'application ou par l'objet)
xlSheet.Cells(I, J + 1) = rec.Fields(J)              '----->  et pr afficher la date je dois mettre dbdate
End If
        Next J
        I = I + 1
rec.MoveNext
Loop
    ' code de fermeture et libération des objets
xlBook.SaveAs "C:\Users\francisD\Documents\Feuille.xlsx"
xlApp.Quit
rec.Close
    Set rec = Nothing
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    t1 = Timer
Debug.Print I &" enregistrements", Format(t1 - t0, "0") & " secondes"
    'Debug.Print (SQL)
End Sub
3) Private Sub Form_Open(Cancel As Integer)
 On Error GoTo Error_FormOpen
 Dim test As String
  'Tester si la requête "Filtre" existe; sinon renvoie l'erreur 2489
 test = CurrentDb.QueryDefs("Filtre").SQL
  ' Efface la requête par mesure de sécurité, afin de ne pas afficher une ancienne recherche
  CurrentDb.QueryDefs("filtre").SQL = "SELECT * FROM " & vSource & "  WHERE false"
  Me![SF_Filtre].Form.RecordSource = "filtre"
Exit Sub
Error_FormOpen:
Select Case Err
    Case 3265 ' la requête filtre n'existe pas,alors on va la créer
    CurrentDb.CreateQueryDef "filtre", "SELECT * FROM " & vSource & "  WHERE false"
    Resume Next
    Case Else
       MsgBox Err.Description
       Exit Sub
End Select
End Su

ACCESS Filtre formulaire sur Inconsistent DAO RECORDSET

1 réponse

Votre réponse

Discussions similaires