texbox listox access ado probleme d'affichage

texbox listox access ado probleme d'affichage - VB/VBA/VBS - Programmation

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

Reply

Marsh Posté le 16-10-2007 à 20:39:20   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed