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 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
| Private Sub UpdateTownList(KeyAscii As Integer)
'Met à jour la liste des communes en fonction des caractères tapés dans la zone de texte
Dim SQL As String
Dim SQLWhere As String
Dim strCityCount As String
'Selon le sens de la recherche
Select Case cmdInvert.Caption
Case CPTOWN_CAPTION
'Sens Code postal => Ville
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 IDPostalCode, PostalCode, Town "
SQL = SQL & "FROM TBLPostalCodes "
SQLWhere = "WHERE PostalCode Like '" & m_strCurrentChars & "*' "
SQL = SQL & SQLWhere & "ORDER BY PostalCode;"
'Et on rafraîchit la liste selon cette clause SQL
SetListOfCityProperties SQL, CPT_TOWN_COLWIDTH
Case TOWNCP_CAPTION
Select Case KeyAscii
Case 8, 32
'Backspace, un espace : acceptés
Case 39, 45
'apostrophe ou tiret : refusés
KeyAscii = 0
MsgBox "Les apostrophes et les tirets ne sont pas normalisés pour les noms des villes !" & _
vbCrLf & vbCrLf & "Rendez-vous ici pour plus d'infos :" & _
vbCrLf & "http://www.laposte.fr/sna/rubrique.php3?id_rubrique=87", vbExclamation, "Erreur de frappe"
m_strCurrentChars = vbNullString
'Voir "http://www.laposte.fr/sna/rubrique.php3?id_rubrique=87" pour plus d'infos
Case 65 To 90
'MAJUSCULE : acceptés
Case 97 To 122
'minuscule : acceptés donc converti en majuscule
KeyAscii = KeyAscii - 32
'MAJUSCULE accentuées
Case 192, 193, 194, 195, 196, 197: KeyAscii = 65 'A
Case 199: KeyAscii = 67 'C
Case 200, 201, 202, 203: KeyAscii = 69 'E
Case 204, 205, 206, 207: KeyAscii = 73 'I
Case 209: KeyAscii = 78 'N
Case 210, 211, 212, 213, 214: KeyAscii = 79 'O
Case 217, 218, 219, 220: KeyAscii = 85 'U
'minuscules accentuées
Case 224, 225, 226, 227, 228, 229: KeyAscii = 65 '97:a
Case 231: KeyAscii = 67 '99:c
Case 232, 233, 234, 235: KeyAscii = 69 '101:e
Case 236, 237, 238, 239: KeyAscii = 73 '105:i
Case 241: KeyAscii = 78 '110:n
Case 242, 243, 244, 245, 246: KeyAscii = 79 '111:o
Case 249, 250, 251, 252: KeyAscii = 85 '117:u
Case Else
'Sinon rien
KeyAscii = 0
MsgBox "Un caractère alphabétique 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
'Si aucun caractère tapé alors on pose un astérisque de manière à ne pas provoquer une erreur
m_strCurrentChars = Trim$(Replace(m_strCurrentChars, vbNullChar, vbNullString))
If Len(m_strCurrentChars) = 0 Then m_strCurrentChars = "*"
'On applique alors le critère à la chaîne SQL
SQL = "SELECT IDPostalCode, Town, PostalCode FROM TBLPostalCodes "
SQLWhere = "WHERE Town Like '" & m_strCurrentChars & "*' "
SQL = SQL & SQLWhere & "ORDER BY Town;"
'Et on rafraîchit la liste selon cette clause SQL
SetListOfCityProperties SQL, TOWN_CPT_COLWIDTH
End Select
'Et on compte le nombre de villes trouvées
Me.lblCountTowns.Caption = CountTownFound(SQLWhere)
End Sub
''' ---------------------------------------------------------------------------------------------------------------------------------------
Private Sub SetListOfCityProperties(ByVal Source As String, ColWidth As String)
'Rafraîchit la liste des villes
With lboPCTowns
.ColumnCount = 3
.BoundColumn = 3
.RowSource = Source
.ColumnWidths = ColWidth
End With
End Sub
''' ---------------------------------------------------------------------------------------------------------------------------------------
Private Function CountTownFound(ByVal SQLWhere As String) As String
'Compte le nombre de villes correspondant au critère
Dim oRS As DAO.Recordset
Dim SQL As String
Dim lngRowCount As Long
On Error GoTo L_ErrCountTownFound
'On ouvre le RecordSet sur le critère en cours...
SQL = "SELECT COUNT(IDPostalCode) AS NBRows "
SQL = SQL & "FROM TBLPostalCodes " & SQLWhere
Set oRS = m_oDB.OpenRecordset(SQL, dbOpenSnapshot)
With oRS
lngRowCount = Nz(.Fields(0).Value, 0)
'Si la variable est > 0
If lngRowCount Then
CountTownFound = lngRowCount & " commune" & IIf(lngRowCount = 1, " ", "s ") & "trouvée" & _
IIf(lngRowCount = 1, " ", "s ")
Else
CountTownFound = "Aucune commune trouvée..."
End If
.Close
End With
On Error GoTo 0
L_ExCountTownFound:
'Libère l'objet de la mémoire
Set oRS = Nothing
Exit Function
L_ErrCountTownFound:
MsgBox Err.Description, vbExclamation, Err.Source
Resume 'L_ExCountTownFound
End Function |
Partager