texbox listox access ado probleme d'affichage - VB/VBA/VBS - Programmation
MarshPosté le 16-10-2007 à 20:39:20
salut j'ai un proble avec une listbox et mes textbox. je suis en vb6 et access 2000.
J'arrive a me connecter, a la base de donnée et a affichée dans la listbox, et a inserer le premier dans la textbox, mais le reste des info ne suive pas. je vous donne le module de connection et le bout de code qui suit.Merci si vous pouvez me remettre sur les rail, en me donnant quel que conseille.
ption Explicit Public CheminBase As String Public sql As String Public Etat_Connection As Boolean Public cnxado As New ADODB.Connection ' Connection base de données Public Rstado As New ADODB.Recordset ' Recordset pour mise à jours bdd Public Sub CloseDataBase()
On Error Resume Next 'au cas où ' Libération ressource
Rstado.Cancel Rstado.Close Set Rstado = Nothing cnxado.Cancel cnxado.Close Set cnxado = Nothing
End Sub
Public Function OpenDataBase() As Boolean
' on la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur? Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données cnxado.Provider = "Microsoft.jet.OLEDB.4.0"
' Resultat de la fonction verif_cehemin_base '<--- juste chemin, pas vérif quoi que ce soit... cnxado.ConnectionString = CheminBase
' Gestion erreur ici !!! (et on poursuit, pas besoin de faire de saut On Error Resume Next
' Ouvre la connection à la source cnxado.Open
' là on traite l'erreur, avec résultat en conséquence OpenDataBase = (Err.Number = 0) Etat_Connection = OpenDataBase If Err.Number Then Err.Clear
End Function
Public Sub SetDataBasePath()
' Récupère le chemin CheminBase = App.Path
' ajoute le slash If Not (LeftB$(CheminBase, 2) = "\Base de donnée\" ) Then CheminBase = CheminBase & "\Base de donnée\" ' ajoute le nom base
CheminBase = CheminBase & "propronostique.mdb" End Sub Public Function Execute_Sql() As Boolean
' en premier, on ferme le dernier enreg On Error Resume Next Rstado.Cancel Rstado.Close
' erreur ou pas, pas besoin de tester Err.Clear
' Execution requête avec paramètre recordset via CnxAdo Rstado.CursorLocation = adUseClient Rstado.Open sql, cnxado, adOpenDynamic, adLockPessimistic
' on est toujours sous la gestion d'erreur Execute_Sql = (Err.Number = 0) If Err.Number Then Err.Clear
End Function
Option Explicit ' Dim Boucle As Integer ' Dim nbhippodrome As Integer ' Variable de cumul pour obtenir le nombre d'enregistrements 'Dim Key As Long ' Récupération valeur clé primaire pour suppression ' Variable récupération index Listview
Private Sub Form_Load() Call init Dim hippodrome As String Sheets("Hippodromeaddresse" ).Select sql = "SELECT * FROM Hippodromeaddresse" ' Préparation de la requêtes ' Initialisation du cumul
'Execution requête Call Execute_Sql nbhippodrome = 0 ' tri par hippodrome Rstado.Sort = "[hippodrome] asc"
' on se place sur le premier enregistrement Rstado.MoveFirst
While Not Rstado.EOF
'On ajoute dans la liste Me.lb.AddItem Rstado!hippodrome
End Sub Private Sub lb_Click() Call bouton2 Dim hippo1 As String Dim hippo2 As String hippo2 = Me.lb hippo1 = Replace(hippo2, "'", "''" ) Me.Texthippo(0).Text = hippo2
sql = "SELECT * FROM hippodrome WHERE Hippodromeaddresse='" & Texthippo(1).Text & "';"
Rstado.MoveFirst 'on remplis les zones texte Sheets("hippodrome" ).Select Texthippo(23).Value = Cells(ListBox1.listIndex + 7, 4)
Marsh Posté le 16-10-2007 à 20:39:20
salut j'ai un proble avec une listbox et mes textbox. je suis en vb6 et access 2000.
J'arrive a me connecter, a la base de donnée et a affichée dans la listbox, et a inserer le premier dans la textbox, mais le reste des info ne suive pas. je vous donne le module de connection et le bout de code qui suit.Merci si vous pouvez me remettre sur les rail, en me donnant quel que conseille.
ption Explicit
Public CheminBase As String
Public sql As String
Public Etat_Connection As Boolean
Public cnxado As New ADODB.Connection ' Connection base de données
Public Rstado As New ADODB.Recordset ' Recordset pour mise à jours bdd
Public Sub CloseDataBase()
On Error Resume Next 'au cas où
' Libération ressource
Rstado.Cancel
Rstado.Close
Set Rstado = Nothing
cnxado.Cancel
cnxado.Close
Set cnxado = Nothing
End Sub
Public Function OpenDataBase() As Boolean
' on la ferme avant, çà évite parfois des surprises. exe : elle est déjà ouverte donc erreur?
Call CloseDataBase
' Choix du fournisseur ,ouverture Base de Données
cnxado.Provider = "Microsoft.jet.OLEDB.4.0"
' Resultat de la fonction verif_cehemin_base '<--- juste chemin, pas vérif quoi que ce soit...
cnxado.ConnectionString = CheminBase
' Gestion erreur ici !!! (et on poursuit, pas besoin de faire de saut
On Error Resume Next
' Ouvre la connection à la source
cnxado.Open
' là on traite l'erreur, avec résultat en conséquence
OpenDataBase = (Err.Number = 0)
Etat_Connection = OpenDataBase
If Err.Number Then Err.Clear
End Function
Public Sub SetDataBasePath()
' Récupère le chemin
CheminBase = App.Path
' ajoute le slash
If Not (LeftB$(CheminBase, 2) = "\Base de donnée\" ) Then CheminBase = CheminBase & "\Base de donnée\"
' ajoute le nom base
CheminBase = CheminBase & "propronostique.mdb"
End Sub
Public Function Execute_Sql() As Boolean
' en premier, on ferme le dernier enreg
On Error Resume Next
Rstado.Cancel
Rstado.Close
' erreur ou pas, pas besoin de tester
Err.Clear
' Execution requête avec paramètre recordset via CnxAdo
Rstado.CursorLocation = adUseClient
Rstado.Open sql, cnxado, adOpenDynamic, adLockPessimistic
' on est toujours sous la gestion d'erreur
Execute_Sql = (Err.Number = 0)
If Err.Number Then Err.Clear
End Function
Option Explicit
'
Dim Boucle As Integer '
Dim nbhippodrome As Integer ' Variable de cumul pour obtenir le nombre d'enregistrements
'Dim Key As Long ' Récupération valeur clé primaire pour suppression
' Variable récupération index Listview
Private Sub Form_Load()
Call init
Dim hippodrome As String Sheets("Hippodromeaddresse" ).Select
sql = "SELECT * FROM Hippodromeaddresse" ' Préparation de la requêtes
' Initialisation du cumul
'Execution requête
Call Execute_Sql
nbhippodrome = 0
' tri par hippodrome
Rstado.Sort = "[hippodrome] asc"
' on se place sur le premier enregistrement
Rstado.MoveFirst
While Not Rstado.EOF
'On ajoute dans la liste
Me.lb.AddItem Rstado!hippodrome
nbhippodrome = nbhippodrome + 1
'On lit l'enregistrement suivant
Rstado.MoveNext
Wend
End Sub
Private Sub lb_Click()
Call bouton2
Dim hippo1 As String
Dim hippo2 As String
hippo2 = Me.lb
hippo1 = Replace(hippo2, "'", "''" )
Me.Texthippo(0).Text = hippo2
sql = "SELECT * FROM hippodrome WHERE Hippodromeaddresse='" & Texthippo(1).Text & "';"
Rstado.MoveFirst
'on remplis les zones texte
Sheets("hippodrome" ).Select
Texthippo(23).Value = Cells(ListBox1.listIndex + 7, 4)
Rstado.MoveNext
End Sub
voila pour le module et dessous le bout de code