Recherche multi-critères

iron -  
 La buse VBA -
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.
Configuration: Windows XP
Internet Explorer 6.0

1 réponse

  1. La buse VBA
     
    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