Sujet Précédent Sujet Suivant

Mise a jour d'une base de données

mick1819 Messages postés 24 Date d'inscription mercredi 21 janvier 2004 Statut Membre Dernière intervention 26 avril 2005 - 30 mars 2005 à 14:01
mick1819 Messages postés 24 Date d'inscription mercredi 21 janvier 2004 Statut Membre Dernière intervention 26 avril 2005 - 30 mars 2005 à 14:33
Bonjour
J'ai fait un menu de recherche pour parcourir la base de donnée de manière simplifiée... j'aimerai modifier les données, mais je n'arrive pas a les mettre a jour dans ma base ...

Voila mon code :

Public ChainePublicRechercheVisu As String
Public IntPublicRechercheVisu As Integer
Dim rst As New ADODB.Recordset
Dim passage As Integer
Dim passageEOFBOF As Integer


Public Function lecture_base(position As Integer)


Dim cnn As New ADODB.Connection
Dim fld As ADODB.Field
Dim cpt As Integer
Dim clause_where As String


On Error Resume Next


clause_where = ChainePublicRechercheVisu


'***Ouverture de la connection***
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"


'***Ouverture du recordset si il n'est pas encore ouvert
If passage = 0 Then
rst.Open "SELECT Type, Marque, Compatibilite, Serie, Couleur, Remarque, Quantite, QuantiteMin FROM TONER where " & clause_where, _
cnn, adOpenDynamic, adLockReadOnly
rst.MoveFirst
passage = 1
End If
cpt = 0
rst.Move (position)

'***Affichage des données dans les textbox appropriés
For Each fld In rst.Fields
If cpt = 0 Then
txtType.Text = fld.Value & " "
End If

If cpt = 1 Then
txtMarque.Text = fld.Value & " "
End If

If cpt = 2 Then
txtCompatibilite.Text = fld.Value & " "
End If

If cpt = 3 Then
txtSerie.Text = fld.Value & " "
End If

If cpt = 4 Then
txtCouleur.Text = fld.Value & " "
End If

If cpt = 5 Then
txtRemarque.Text = fld.Value & " "
End If

If cpt = 6 Then
txtQuantite.Text = fld.Value & " "
End If

If cpt = 7 Then
txtQuantiteMin.Text = fld.Value & " "
End If

cpt = cpt + 1
Next

End Function


Private Sub buEnregistrer_Click()
rst.Update

txtType.Locked = True
txtMarque.Locked = True
txtCompatibilite.Locked = True
txtSerie.Locked = True
txtCouleur.Locked = True
txtQuantite.Locked = True
txtQuantiteMin.Locked = True
txtRemarque.Locked = True

buSuivant.Enabled = True
buPrecedent.Enabled = True
buDernier.Enabled = True
buPremier.Enabled = True
buModifier.Enabled = True
buSupprimer.Enabled = True
buRetour.Enabled = True

buEnregistrer.Enabled = False

End Sub


Private Sub buModifier_Click()
txtType.Locked = False
txtMarque.Locked = False
txtCompatibilite.Locked = False
txtSerie.Locked = False
txtCouleur.Locked = False
txtQuantite.Locked = False
txtQuantiteMin.Locked = False
txtRemarque.Locked = False

buSuivant.Enabled = False
buPrecedent.Enabled = False
buDernier.Enabled = False
buPremier.Enabled = False
buModifier.Enabled = False
buSupprimer.Enabled = False
buRetour.Enabled = False

buEnregistrer.Enabled = True

End Sub


Private Sub buPrecedent_Click()
lecture_base (-1)
End Sub


Private Sub buRetour_Click()


fmRechercherVisualisation.Visible = False
fmMain.Visible = True

End Sub


Private Sub buSuivant_Click()
lecture_base (1)
End Sub


Private Sub Form_Activate()

On Error Resume Next
passage = 0


lecture_base (0)


End Sub

J'ai une erreur sur la ligne qui est en rouge ! est-ce que quelqu'un peu m'aider ???

Mick

2 réponses

Réponse 1 / 2
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 27
30 mars 2005 à 14:21
Rst.update n' a pas à se trouver dans cette procédure qui de toutes façons n'enregistre rien, elle ne fait que blocquer les textbox et les boutons de commande.

Dans une commande d'enregistrement Update est toujours précédé de AddNew ou Edit
et apparement ton code ne fait que récupérer des données dans des textBox.

Je vais essayer de créer une base et copier ton code pour voir comment faire.

jpleroisse
0
Réponse 2 / 2
mick1819 Messages postés 24 Date d'inscription mercredi 21 janvier 2004 Statut Membre Dernière intervention 26 avril 2005
30 mars 2005 à 14:33
Mais en fait j'ai fait un menu de recherche


quand tu arrive dessus tu peu entrer les données à rechercher dans des textbox


ensuite il charge une form avec le code que j'ai mis ci-dessus ... et il affiche les données dans des textbox !!! tout fonctionne sauf l'enregistrement des données qui ont été modifiées...

Si ca peut t'aider voila le code de ma form précédente : (les chType, ... sont des checkbox)

Private Sub buRechercher_Click()
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim fld As ADODB.Field
Dim clause_where As String
Dim OK As Integer
Dim passage As Integer
Dim nb_trouver As Integer
Dim rep As Integer


OK = 0
passage = 0
nb_trouver = 0


txtType = Replace(txtType, "'", "''")
txtMarque = Replace(txtMarque, "'", "''")
txtCompatibilite = Replace(txtCompatibilite, "'", "''")
txtSerie = Replace(txtSerie, "'", "''")
txtCouleur = Replace(txtCouleur, "'", "''")
txtRemarque = Replace(txtRemarque, "'", "''")


'***Ecriture de la clause where en fonction des choix de l'opérateur
If chType.Value = 1 Then
clause_where = "Type LIKE'%" & txtType & "%'"
passage = 1
End If


If chType.Value 1 And txtType.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chMarque.Value = 1 Then
clause_where = "Marque LIKE'%" & txtMarque & "%'"
passage = 1
End If


If chMarque.Value 1 And passage 0 Then
clause_where = clause_where & "Marque LIKE'%" & txtMarque & "%'"
passage = 1
End If


If chMarque.Value 1 And txtMarque.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chCompatibilite.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "Compatibilite LIKE'%" & txtCompatibilite & "%'"
End If


If chCompatibilite.Value 1 And passage 0 Then
clause_where = clause_where & "Compatibilite LIKE'%" & txtCompatibilite & "%'"
passage = 1
End If


If chCompatibilite.Value 1 And txtCompatibilite.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chSerie.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "Serie='" & txtN° & "'"
End If


If chSerie.Value 1 And passage 0 Then
clause_where = "Serie='" & txtSerie & "'"
passage = 1
End If


If chSerie.Value 1 And txtSerie.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chCouleur.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = "Couleur LIKE'%" & txtCouleur & "%'"
End If


If chCouleur.Value 1 And passage 0 Then
clause_where = "Couleur LIKE'%" & txtCouleur & "%'"
passage = 1
End If


If chCouleur.Value 1 And txtCouleur.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chRemarque.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "Remarque LIKE'%" & txtRemarque & "%'"
End If


If chRemarque.Value 1 And passage 0 Then
clause_where = clause_where & "Remarque LIKE'%" & txtRemarque & "%'"
passage = 1
End If


If chRemarque.Value 1 And txtRemarque.Text "" Then
MsgBox "Vous avez mal formulé votre recherche", vbExclamation, "Erreur"
chMarque.Value = 0
chType.Value = 0
chRemarque.Value = 0
chCouleur.Value = 0
chSerie.Value = 0
chCompatibilite.Value = 0
GoTo FIN
End If


If chQuantite.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "Quantite LIKE'%" & txtQuantite & "%'"
End If


If chQuantite.Value 1 And passage 0 Then
clause_where = clause_where & "Quantite LIKE'%" & txtQuantite & "%'"
passage = 1
End If


If chQuantiteMin.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "QuantiteMin LIKE'%" & txtQuantiteMin & "%'"
End If


If chQuantiteMin.Value 1 And passage 0 Then
clause_where = clause_where & " QuantiteMin LIKE'%" & txtQuantiteMin & "%'"
passage = 1
End If


If chID.Value 1 And passage 1 Then
clause_where = clause_where & " AND "
clause_where = clause_where & "ID LIKE'%" & txtID & "%'"
End If


If chID.Value 1 And passage 0 Then
clause_where = clause_where & " QuantiteMin LIKE'%" & txtID & "%'"
passage = 1
End If


If passage = 0 Then
rep = MsgBox("Vous avez mal formulé votre recherche", vbOKOnly + vbExclamation, "Erreur...")

txtType.Text = ""
txtMarque.Text = ""
txtCompatibilite.Text = ""
txtCouleur.Text = ""
txtRemarque.Text = ""
chType.Value = 0
chMarque.Value = 0
chCompatibilite.Value = 0
chSerie.Value = 0
chCouleur.Value = 0
chRemarque.Value = 0

GoTo FIN
End If


'***Fin écriture clause WHERE*********


'***Ouverture de la connection***
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=" & "C:\Documents and Settings\tsilomi1\Desktop\Toner\Toner.mdb;"


'***On regarde si la requete retourne un résultat***
rst.Open "SELECT ID, Type, Marque, Compatibilite, Serie, Couleur, Remarque, Quantite, QuantiteMin FROM TONER where " & clause_where, _
cnn, adOpenForwardOnly, adLockReadOnly
Do Until rst.EOF
For Each fld In rst.Fields
OK = 1 'Si on trouve un resultat on montre le resultat
Next
rst.MoveNext
nb_trouver = nb_trouver + 1 'nb_trouver=nombre de films trouver
Loop
'********************************
rst.Close
cnn.Close


If OK = 1 Then
fmRechercherVisualisation.ChainePublicRechercheVisu = clause_where
fmRechercherVisualisation.IntPublicRechercheVisu = nb_trouver
fmRechercherVisualisation.Show
fmRechercher.Hide
Else
rep = MsgBox("Aucun résulatat trouvé", vbOKOnly + vbExclamation, "Aucun résultat")
End If


FIN:
End Sub


Private Sub buRetour_Click()
fmRechercher.Visible = False
fmMain.Visible = True

txtType.Text = ""
txtMarque.Text = ""
txtCompatibilite.Text = ""
txtSerie.Text = ""
txtCouleur.Text = ""
txtRemarque.Text = ""
chType.Value = 0
chMarque.Value = 0
chCompatibilite.Value = 0
chSerie.Value = 0
chCouleur.Value = 0
chRemarque.Value = 0

End Sub


Private Sub Form_Load()

txtType.Text = ""
txtMarque.Text = ""
txtCompatibilite.Text = ""
txtSerie.Text = ""
txtCouleur.Text = ""
txtRemarque.Text = ""
chType.Value = 0
chMarque.Value = 0
chCompatibilite.Value = 0
chSerie.Value = 0
chCouleur.Value = 0
chRemarque.Value = 0


End Sub

Je voulai faire plus simple en mettant directement le composant ADO mais je ne sais pas comment faire des recherches avec ca .... si tu le sais ca m'aiderai énormément



Mick
0

Discussions similaires

Prob de Restauration base de données
cindyb -
Orange -

3 réponses
L’opération doit utiliser une requête qui peut être mise à jour
cs_meryamaa -
meryamaa -

8 réponses
Mise a jour DELPHI
jmj01 -
cantador -

4 réponses
conception base de données e-commerce
av -
f0xi -

4 réponses
Problème connection base de données SQL EBP
romzzz13 -
GUGU38 -

23 réponses
Rejoignez-nous