ACCESS Filtre formulaire sur Inconsistent DAO RECORDSET

Signaler
Messages postés
420
Date d'inscription
vendredi 17 novembre 2006
Statut
Membre
Dernière intervention
15 juillet 2014
-
 dofrancis3 -
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.

1 réponse

Messages postés
2
Date d'inscription
lundi 22 août 2011
Statut
Membre
Dernière intervention
18 juillet 2013

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
il y a personne pour m'aider?