Recherche multi-critères

Fermé
iron - 13 mai 2008 à 09:44
 La buse VBA - 23 juin 2008 à 16:53
Bonjour,

J'ai un petit problème de programmation dans access. Etant plus que novice en programmation, j'ai repris l'exemple de la recherche multi-critère de "caféine".
Au lancement j'ai cette erreur

erreur d'execution '2001' : débogage
erreur sur le ligne lblStat en gras
Voici la programmation, si quelqu'un a une solution, elle sera la bienvenue

Option Compare Database

Private Sub chkTransfert_Click()
If Me.chkTransfert Then
Me.cmbRechtransfert.Visible = False
Else
Me.cmbRechtransfert.Visible = True
End If

RefreshQuery

End Sub

Private Sub chkDépartement_Click()
If Me.chkDépartement Then
Me.cmbRechDépartement.Visible = False
Else
Me.cmbRechDépartement.Visible = True
End If

RefreshQuery

End Sub

Private Sub cmbRechDépartement_BeforeUpdate(Cancel As Integer)

RefreshQuery

End Sub

Private Sub cmbRechTransfert_BeforeUpdate(Cancel As Integer)

RefreshQuery

End Sub

Private Sub Form_Load()

Dim ctl As Control

For Each ctl In Me.Controls
Select Case Left(ctl.Name, 3)
Case "chk"
ctl.Value = -1
Case "lbl"
ctl.Caption = "- * - * -"
Case "txt"
ctl.Visible = False
ctl.Value = ""
Case "cmb"
ctl.Visible = False
End Select
Next ctl

Me.lstCorbeille.RowSource = "SELECT Num, Corbeille, Gp_Prestataires, RDVOO, Intervenant FROM CORBEILLE"
Me.lstCorbeille.Requery

End Sub

Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String

SQL = "SELECT Num, Corbeille, Gp_Prestataires, RDVOO, Intervenant FROM CORBEILLE Where CORBEILLE!Num <> 0"

If Not Me.chkTransfert Then
SQL = SQL & "And CORBEILLE!Transfert = '" & Me.cmbRechtransfert & "' "
End If

If Not Me.chkDépartement Then
SQL = SQL & "And CORBEILLE!Département = " & Me.cmbRechDépartement & " "
End If

SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where") - Len("Where") + 1))
SQL = SQL & ";"

Debug.Print SQL

Me.lblStats.Caption = DCount("*", "CORBEILLE", SQLWhere) & " / " & DCount("*", "CORBEILLE")
Me.lstCorbeille.RowSource = SQL
Me.lstCorbeille.Requery

End Sub

Private Sub lstCorbeille_DblClick(Cancel As Integer)

DoCmd.OpenForm "frmAutoCorbeille", acNormal, , "Num = '" & Me.lstCorbeille & "'"

End Sub

Merci.

1 réponse

La buse VBA
23 juin 2008 à 16:53
moi aussi j'ai le même problème



Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String
Dim ORDER As String
Dim ORDERBY As String

SQL = "SELECT A.Num_compte, A.ACTIF, A.DCM, A.COMPTES, A.PAYS, A.LIBELLE, A.SAP_NEW AS SAPnew, A.SAP_NEW_Libelle_ENG, A.SAPold AS SAPold, A.SAP_OLD_Libelle_ENG, A.Ajout, A.DateAjout, A.PL, A.PL_REG01, A.NS, A.NS_REG01, A.NS_REG02 FROM qry000ListeComptes AS A WHERE A.COMPTES<>0"


If Not Me.ChkACTIF Then
SQL = SQL & " And A!ACTIF = '" & Me.CmbACTIF & "' "
End If

If Not Me.ChkDCM Then
SQL = SQL & " And A!DCM = '" & Me.CmbDCM & "' "
End If

If Not Me.ChkComptes Then
SQL = SQL & " And A!Num_compte like '*" & Me.TxtComptes & "*' "
End If

If Not Me.chkSAPnew Then
If Me.txtSAPnew = "" Or IsEmpty(Me.txtSAPnew) = True Or IsNull(Me.txtSAPnew) Then
SQL = SQL
Else
SQL = SQL & " And A.SAP_NEW like '*" & Me.txtSAPnew & "*' "
End If
End If

If Not Me.chkSAPnewLIB Then
If IsEmpty(Me.txtSAPnewLIB) Then
SQL = SQL
Else
SQL = SQL & " And A.SAP_NEW_Libelle_ENG like '*" & Me.txtSAPnewLIB & "*' "
End If
End If

If Not Me.chkSAPold Then
If Me.txtSAPold = "" Or IsEmpty(Me.txtSAPold) = True Or IsNull(Me.txtSAPold) Then
SQL = SQL
Else
SQL = SQL & " And A.SAPold like '*" & Me.txtSAPold & "*'"
End If
End If

If Not Me.chkSAPoldLIB Then
SQL = SQL & " And A.SAP_OLD_Libelle_ENG like '*" & Me.txtSAPoldLIB & "*' "
End If

If Not Me.ChkPAYS Then
SQL = SQL & " And A!PAYS = '" & Me.cmbPays & "' "
End If

If Not Me.ChkLIBELLES Then
SQL = SQL & " And A!LIBELLE like '*" & Me.TxtLIBELLES & "*' "
End If

If Not Me.ChkAJOUT Then
SQL = SQL & " And A!Ajout = '" & Me.CmbAJOUT & "' "
End If

If Not Me.ChkDateAjout Then
SQL = SQL & " And A!DateAjout between #" & Me.TxtDateAjout_DEBUT & "# and #" & Me.TxtDateAjout_FIN & "#"
End If

If Not Me.ChkPL Then
SQL = SQL & " And A!PL = '" & Me.CmbPL & "' "
End If

If Not Me.ChkPL_REG01 Then
SQL = SQL & " and A!PL_REG01 = '" & Me.CmbPL_REG01 & "' "
End If

If Not Me.ChkNS Then
SQL = SQL & " and A!NS = '" & Me.CmbNS & "' "
End If

If Not Me.ChkNS_REG01 Then
SQL = SQL & " and A!NS_REG01 = '" & Me.CmbNS_REG01 & "' "
End If

If Not Me.ChkNS_REG02 Then
SQL = SQL & " and A!NS_REG02 = '" & Me.CmbNS_REG02 & "' "
End If

'If Me.btbACTIF = -1 Then
'ORDER = " A!ACTIF"
'End If

'If Me.btbDCM = -1 Then
'ORDER = " A!DCM"
'End If

'If Me.btbComptes = -1 Then
'ORDER = " A!Num_compte"
'End If

'If Me.btbACTIF = -1 Then
'ORDER = " A!ACTIF"
'End If

'If Me.btbPays = -1 Then
'ORDER = " A!PAYS"
'End If

'If Me.btbLibellés = -1 Then
'ORDER = " A!LIBELLE"
'End If

'If Me.btbAjout = -1 Then
'ORDER = " A!Ajout"
'End If

'If Me.btbPL = -1 Then
'ORDER = " A!PL"
'End If

'If Me.btbPL_REG01 = -1 Then
'ORDER = " A!PL_REG01"
'End If

'If Me.btbNS = -1 Then
'ORDER = " A!NS"
'End If

'If Me.btbNS_REG01 = -1 Then
'ORDER = " A!NS_REG01"
'End If

'If Me.NS_REG02 = -1 Then
'ORDER = " A!NS_REG02"
'End If

' ORDERBY = "ORDER BY " & ORDER


SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
Debug.Print SQLWhere

SQL = SQL & ORDER & ";"

Debug.Print SQL

Me.lblStats.Caption = DCount("*", "qry000ListeComptes2", SQLWhere) & " / " & DCount("*", "tblBIBLIOTHEQUE")
Me.LstComptes.RowSource = SQL
Me.LstComptes.Requery
'Go_Controle

End Sub
0