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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
Private Sub UpdateFactureList(KeyAscii As Integer)
'Met à jour la liste des factures en fonction des caractères tapés dans la zone de texte
Dim SQL As String
Dim SQLWhere As String
Dim strFacturesCount As String
Select Case KeyAscii
Case 8, 48 To 57
'Backspace ou un nombre : acceptés
Case Else
'Sinon rien
KeyAscii = 0
MsgBox "Un caractère numérique est requis ici !", vbExclamation, "Erreur de frappe"
m_strCurrentChars = vbNullString
Exit Sub
End Select
If KeyAscii = 8 Then
'Si on appuie sur Backspace alors on retire un caractère
On Error Resume Next
m_strCurrentChars = Left$(m_strCurrentChars, Len(m_strCurrentChars) - 1)
On Error GoTo 0
Else
'Sinon la variable s'incrémente et prend le caractère tapé
m_strCurrentChars = m_strCurrentChars & Chr(KeyAscii)
End If
'On applique alors le critère à la chaîne SQL
SQL = "SELECT tbl_Contrat.PK_Contrat, tbl_Releve.PK_Releve, tbl_Facture.PK_Facture, tbl_Facture.Date_Facture, tbl_Facture.Etat_Facture, tbl_Facture.Total_Net, tbl_Facture.Date_DernierDilai"
SQL = SQL & "FROM tbl_Contrat INNER JOIN tbl_Releve ON tbl_Contrat.PK_Contrat = tbl_Releve.FK_Contrat INNER JOIN tbl_Facture ON tbl_Releve.PK_Releve = tbl_Facture.FK_Releve"
SQLWhere = SQL & " WHERE (tbl_Facture.Etat_Facture = 'En attente') AND (tbl_Contrat.PK_Contrat Like '" & m_strCurrentChars & "*') "
SQL = SQL & SQLWhere
'Et on rafraîchit la liste selon cette clause SQL
SetListOfFactureProperties SQL, CON_FAC_COLWIDTH
'Et on compte le nombre de factures trouvées
Me.lblCountFactures.Caption = CountFactureFound(SQLWhere)
'Si la zone ne contient que * on efface la variable (cas de KeyAscii = 8)
If Len(m_strCurrentChars) Then
If (Asc(Left$(m_strCurrentChars, 1)) = 42) And (Len(m_strCurrentChars) = 1) Then
m_strCurrentChars = vbNullString
End If
End If
End Sub
Private Sub SetListOfFactureProperties(ByVal Source As String, ColWidth As String)
'Rafraîchit la liste des factures
With lboFactures
.ColumnCount = 7
.BoundColumn = 7
.RowSource = Source
.ColumnWidths = ColWidth
End With
End Sub
Private Function CountFactureFound(ByVal SQLWhere As String) As String
'Compte le nombre de factures correspondant au critère
Dim oRS As DAO.Recordset
Dim SQL As String
Dim lngRowCount As Long
On Error GoTo L_ErrCountFactureFound
'On ouvre le RecordSet sur le critère en cours...
SQL = "SELECT COUNT(PK_Facture) AS NBRows "
SQL = SQL & "FROM tbl_Facture " & SQLWhere
Set oRS = m_oDB.OpenRecordset(SQL, dbOpenSnapshot)
With oRS
lngRowCount = Nz(.Fields(0).Value, 0)
'Si la variable est > 0
If lngRowCount Then
CountFactureFound = lngRowCount & " facture" & IIf(lngRowCount = 1, " ", "s ") & "trouvée" & _
IIf(lngRowCount = 1, " ", "s ")
Else
CountFactureFound = "Aucune facture trouvée..."
End If
.Close
End With
On Error GoTo 0
L_ExCountFactureFound:
'Libère l'objet de la mémoire
Set oRS = Nothing
Exit Function
L_ErrCountFactureFound:
MsgBox Err.Description, vbExclamation, Err.Source
Resume 'L_ExCountFactureFound
End Function |
modifier une instruction SQL en VBA
Répondre avec citation
Envoyé par micniv
Partager