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 146 147 148 149 150 151 152 153 154
|
Private Sub VerifDoublon()
Dim dbs As DAO.Database
Dim rstCli As DAO.Recordset
Dim rstCliTable As DAO.Recordset
Dim strSQL As String
Dim strClient As String
Dim strCrit As String
Dim Reponse
'Déclaration des variables
Dim ContenuChamps
Dim ValeurColonne1
Dim ValeurColonne2
Dim ValeurColonne3
Dim ValeurColonne4
Dim ValeurColonne5
Dim ValeurColonne6
Set dbs = CurrentDb
'Set rstCli = dbs.OpenRecordset("T-Client", dbOpenSnapshot)
strSQL = "SELECT [T-client].*, [T-Cedex].Ville"
strSQL = strSQL + " FROM [T-Cedex] RIGHT JOIN [T-client] ON [T-Cedex].CP = [T-client].CPClient;"
'Ouverture de la requête
Set rstCli = dbs.OpenRecordset(strSQL)
Set rstCliTable = dbs.OpenRecordset("T-Client", dbOpenDynaset)
strClient = Me!NomClientForm
'MsgBox strClient
With rstCli
.MoveLast
'création du critère de recherche
strCrit = "nomclient like '*" & strClient & "*'"
.FindFirst strCrit
' test s'il existe un enregistrement
If .NoMatch Then
Reponse = MsgBox("Aucun client de portant se nom n'est référencé, Voulez-vous l'ajouter à la base?", vbYesNo, "Confirmation")
If Reponse = vbYes Then
'création d'un nouvelle enregistrement
rstCliTable.AddNew
'remplissage des champs
rstCliTable!NomClient = Me!NomClientForm
'rstCliTable!PrenomClient = Me!PrenomClientForm
'rstCliTable!AdrClient = Me!AdrClientForm
'rstCliTable!AdrSuiteClient = Me!AdrSuiteClientForm
'rstCliTable!CPClient = Me!CPClientForm
'Sauvegarde du nouvel enregistrement
rstCliTable.Update
rstCliTable.MoveLast
Me!CodeClient = rstCliTable!CodeClient
MsgBox "" & rstCliTable!CodeClient
End If
Else
' IL EXISTE DES ENREGISTREMENTS QUI CORREPONDEN AUX CRITERES
DoCmd.OpenForm "F-Doublonclient"
'Vidage de la liste
Forms![F-doublonclient]!ListeDoublonClient.ListItems.Clear
'Affichage des entêtes
Forms![F-doublonclient]!ListeDoublonClient.HideColumnHeaders = False
'Détermination des entêtes centrage lvwColumnCenter lvwColumnRight lvwColumnleft
With Forms![F-doublonclient]!ListeDoublonClient.ColumnHeaders
.Clear
.Add , , "Code", 0, lvwColumnLeft
.Add , , "Nom", 2000, lvwColumnLeft
.Add , , "Prénom", 1200, lvwColumnLeft
.Add , , "Adresse", 2700, lvwColumnLeft
.Add , , "CP", 700, lvwColumnCenter
.Add , , "Ville", 2700, lvwColumnLeft
End With
'recherche tous les enregistrement correspondant aux critères
Do While True
' MsgBox rstCli!NomClient
'Ajout des lignes
' While Not rstCli.EOF
ValeurColonne1 = rstCli!CodeClient
ValeurColonne2 = rstCli!NomClient
ValeurColonne3 = rstCli!PrenomClient
ValeurColonne4 = rstCli!AdrClient
ValeurColonne5 = rstCli!CPClient
ValeurColonne6 = rstCli!Ville
Set itmAdd = Forms![F-doublonclient]!ListeDoublonClient.ListItems.Add()
'Ajout contenu colonne 1
itmAdd.Text = ValeurColonne1
'Ajout contenu colonne 2
If IsNull(ValeurColonne2) Then
ContenuChamps = ""
Else
ContenuChamps = ValeurColonne2
End If
itmAdd.SubItems(1) = ContenuChamps
'Ajout contenu colonne 3
If IsNull(ValeurColonne3) Then
ContenuChamps = ""
Else
ContenuChamps = ValeurColonne3
End If
itmAdd.SubItems(2) = ContenuChamps
'Ajout contenu colonne 4
If IsNull(ValeurColonne4) Then
ContenuChamps = ""
Else
ContenuChamps = ValeurColonne4
End If
itmAdd.SubItems(3) = ContenuChamps
'Ajout contenu colonne 5
If IsNull(ValeurColonne5) Then
ContenuChamps = ""
Else
ContenuChamps = ValeurColonne5
End If
itmAdd.SubItems(4) = ContenuChamps
'Ajout contenu colonne 6
If IsNull(ValeurColonne6) Then
ContenuChamps = ""
Else
ContenuChamps = ValeurColonne6
End If
itmAdd.SubItems(5) = ContenuChamps
.FindNext strCrit
If .NoMatch Then Exit Do
Loop
rstCli.Close
Forms![F-doublonclient]!ListeDoublonClient.SortKey = 1
Forms![F-doublonclient]!ListeDoublonClient.SortOrder = lvwAscending
'Forms![F-ListeClient]!BT_Supprimer.Enabled = False
End If
End With
End Sub |
Partager