Combobox excel critère rechercheV dans table Runtime Access

pyrus2047 -  
Bonjour
sur une machine qui dispose uniquement du runtime access
j'ai dans un userform excel qui contiens une combobox que je souhaite charger avec une colonne d'une table runtime Access et je souhaite me servir de cette combo box comme critère pour
faire une sorte de rechercheV dans ma table access et recuperer la ligne trouver
dans mes textbox de mon userform excel

15 réponses

  • Votes
  • Date
  • Date décroissante
Résumé de la discussion

Le problème porte sur charger une combobox d'un UserForm Excel à partir d'une table Access en runtime et utiliser cette sélection comme critère de recherche pour remplir des textbox. Des solutions envisagées utilisent ADODB pour se connecter à Access, des requêtes SQL avec LIKE sur les colonnes Module ou Rendt, et des méthodes pour alimenter le ListView et les TextBox. Plusieurs échanges soulignent le besoin de récupérer l'identifiant (clé primaire) pour relier la ligne trouvée à l'affichage des TextBox. En cas de progression, les pistes évoquent surtout la validation de la colonne correcte (renommer Module), l'emploi d'ADODB avec une requête ciblée et l'extraction de l'ID via ComboBox_Change.

Bobot (l’IA à votre service)
  1. yg_be Contributeur
    si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?
    1. pyrus2047 Auteur
      Bonjour
      merci je vais me débrouiller
      Cordialement
      1. yg_be Contributeur
        si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?
    2. pyrus2047 Auteur
      ok merci cet appel au secoure c' est pour gagné du temps
      1. yg_be Contributeur
        cela fait plusieurs années que tu débutes, tu gagneras plus de temps en progressant.
        dans quel contexte fais-tu ce travail?
    3. pyrus2047 Auteur
      C'est bien le combobox change que je n'arrive pas a finalisé
      Je pense que c'est cette ligne n'est pas correctement écrite si tu vois d'où vient le problème ? 
      Sql = "select * from [Materiel] where ID=" & CLng(TextBox1) & ";"
      1.  yg_be Contributeur
        oui, j'y vois deux problèmes.
        - pourquoi y utilises-tu textbox1? que contient textbox1 à ce moment-là?
        - pourquoi utilises-tu CLng? que penses-tu que cela fait?
      2. pyrus2047 Auteur
        @yg_beJe ne sais pas j'ai tanté d'adapter cette ligne j'ai récupéré d'un autre projet je suis débutant
      3. yg_be Contributeur
        @pyrus2047si tu es débutant et que tu veux progresser, prends le temps de réfléchir et de chercher.
    5. pyrus2047 Auteur
      Non parce que c'est le n°de l'enregistrement dans access que j'ai besoin de récupérer dans textbox 1 pour que quand je fais un choix dans combobox 1 le n°de l'enregistrement qui lui correspond dans textbox 1
      1. yg_be Contributeur
        il s'agit bien d'adapter ComboBox1_Change()?
        décris fonctionnellement ce que tu veux réaliser.
        que contient combox1? pourquoi n'utilises-tu pas combobox1 dans ComboBox1_Change()?
        tu ne veux tout de même pas écrire 
        textbox1=rs!ID
        ? à quoi cela sert-il, puisque tu viens de faire une sélection en précisant ID dans le where?
    6. pyrus2047 Auteur
      Bonjour
      voila ou j'en suis mais j'ai besoin de récupéré dans la textbox 1 le n°(ID) de la clé primaire qui
      correspond a la ligne du critère de recherche dans la combobox 1 

       Private Declare Function FindWindowA& Lib "user32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "user32" (ByVal hwnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "user32" (ByVal hwnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "user32" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Option Compare Text
Option Explicit
Dim Conn As Object
Dim connstring
Dim rs As Object
Dim Sql
Dim TInfos
Dim Flag_Nok As Boolean
Dim NbRecord
Dim Flg_Boutons As Boolean

Private Sub UserForm_Initialize()
Dim rs As Object
Dim Nom_Base, Chemin_Base, Sql, Admin, Uid, pwd, ExtendedAnsiSQL ', connstring

Set Conn = CreateObject("ADODB.Connection")
Nom_Base = "table.accdb"
Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base
connstring = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Chemin_Base & ";Uid=Admin;Pwd=xxxxx;ExtendedAnsiSQL=1;"
Conn.Open connstring
Recherche_Infos
End Sub
Sub Recherche_Infos()
Dim rs As Object
Dim DT1, DT2
Dim PartTxt, Sql, SQL1, n, L, c, D, e, NbF
On Error Resume Next
Set rs = CreateObject("ADODB.recordset")
PartTxt = ComboBox1

Sql = "select * from [Materiel] where [Module] like '%" & PartTxt & "%' or [Rendt] like '%" & PartTxt & "%' or [Longueur] like '%" & PartTxt & "%' or [Largeur] like '%" & PartTxt & "%'"
rs.Open Sql, Conn, 3, 3
If Not rs.EOF Then
rs.MoveFirst
NbF = rs.Fields.Count
NbRecord = rs.RecordCount
Do While Not rs.EOF
ComboBox1.AddItem rs!Module
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
End Sub
Private Sub ComboBox1_Change()
    If TextBox1 <> "" Then
        Set rs = CreateObject("ADODB.recordset")
        Sql = "select * from [Materiel] where ID=" & CLng(TextBox1) & ";"
        rs.Open Sql, Conn, 3, 3
        If Not rs.EOF And Not rs.BOF Then
            TextBox2 = rs.Fields(1)
            TextBox3 = rs.Fields(2)
            TextBox4 = rs.Fields(3)
            TextBox5 = rs.Fields(4)
            rs.Update
        End If
        rs.Close
        Set rs = Nothing
    End If
End Sub
      1.  yg_be Contributeur
        as-tu essayé 
        textbox1=combobox1
        ?
    7. pyrus2047 Auteur
      Bonjour
      désolé c'est la colonne module que j'ai oublié de renommée Matériel
      2. pyrus2047 Auteur
        si en ligne 27 mais ca veux pas j'ai comme ca mais ca veux toujour pas 

        Sub Connecte_base_Access()
    Dim rs As Object
    Dim Nom_Base, Chemin_Base, Sql, Admin, Uid, pwd, conn, ExtendedAnsiSQL, connstring

    Set conn = CreateObject("ADODB.Connection")
    Nom_Base = "table.accdb"
    Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base
    connstring = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Chemin_Base & ";Uid=Admin;Pwd=XXXX;ExtendedAnsiSQL=1;"
    conn.Open connstring
End Sub
Sub Recherche_Infos_Affichage_LVW()
    Dim rs As Object
    Dim DT1, DT2
    Dim PartTxt, Sql, SQL1, n, L, c, D, e, NbF
On Error Resume Next
    Set rs = CreateObject("ADODB.recordset")
    PartTxt = ComboBox1

    Sql = "select * from [Materiel] where [XXXXXXX] like '%"
    rs.Open Sql, conn, 3, 3
    If Not rs.EOF Then
    rs.MoveFirst
    Do While Not rs.EOF
        ComboBox1.AddItem rs!Materiel
        rs.MoveNext
    Loop
        MsgBox "Attention: pas d'enregistrement trouvé!!"
    End If
    rs.Close
    Set rs = Nothing
End Sub
        1.  yg_be Contributeur
          pourrais-tu partager tes deux fichiers?
      3. pyrus2047 Auteur
        La combobox ne charge pas ! 

        Sub Connecte_base_Access()
Dim rs As Object
Dim Nom_Base, Chemin_Base, Sql, Admin, Uid, pwd, ExtendedAnsiSQL ', connstring

Set conn = CreateObject("ADODB.Connection")
Nom_Base = "table.accdb"
Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base
connstring = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Chemin_Base & ";Uid=Admin;Pwd=xxxxx;ExtendedAnsiSQL=1;"
conn.Open connstring
End Sub
Sub Recherche_Infos_Affichage_LVW()
Dim rs As Object
Dim DT1, DT2
Dim PartTxt, Sql, SQL1, n, L, c, D, e, NbF
On Error Resume Next
Set rs = CreateObject("ADODB.recordset")
PartTxt = combobox1

Sql = "select * from [Materiel] where [xxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' or [xxxxxxx] like '%" & PartTxt & "%' or [xxxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%'"
rs.Open Sql, conn, 3, 3
If Not rs.EOF Then
rs.MoveFirst
NbF = rs.Fields.Count
NbRecord = rs.RecordCount
n = 1
Do While Not rs.EOF
combobox1.AddItem rs!Materiel
With combobox1
.ListItems.Add , , rs.Fields(0)
For L = 2 To NbF

.ListItems(n).ListSubItems.Add , , rs.Fields(L - 1)
Next L
If .ListItems(n) = combobox1 Then .ListItems(n).Bold = True
If .ListItems(n).ListSubItems(5).Text = "INDISPONIBLE" Then
.ListItems(n).Bold = True
.ListItems(n).ForeColor = vbRed
For c = 1 To .ColumnHeaders.Count - 1
.ListItems(n).ListSubItems(c).Bold = True
.ListItems(n).ListSubItems(c).ForeColor = vbRed 'couleur colonne 2
Next c

Else

If .ListItems(n).ListSubItems(5).Text = "DISPONIBLE" Then
.ListItems(n).Bold = True
.ListItems(n).ForeColor = vbGreen
For e = 1 To .ColumnHeaders.Count - 1
.ListItems(n).ListSubItems(e).Bold = True
.ListItems(n).ListSubItems(e).ForeColor = vbGreen 'couleur colonne 2
Next e

Else
If .ListItems(N).ListSubItems(8).Text = "RESERVATION" Then
.ListItems(N).Bold = True
.ListItems(N).ForeColor = vbCyan
For d = 1 To .ColumnHeaders.Count - 1
.ListItems(N).ListSubItems(d).Bold = True
.ListItems(N).ListSubItems(d).ForeColor = vbCyan 'couleur colonne 2
Next d
End If
End If
End If
End With
n = n + 1
rs.MoveNext
Loop
Label2.Caption = NbRecord & " enregistrement(s) !"
Else
MsgBox "Attention: pas d'enregistrement trouvé!!"
End If
rs.Close
Set rs = Nothing

End Sub
        1.  yg_be Contributeur
          tu 'as pas utilisé ma suggestion.
      4. pyrus2047 Auteur
        Ca ne fonctionne pas
        1. yg_be Contributeur
          "Ca ne fonctionne pas": partage ton code, décris le symptôme.
      5. pyrus2047 Auteur
        Ok je souhaite remplacer TextBox1 par combobox1 charger avec la colonne"Materiel" de ma table access et remplacer la ListView1 par des textbox qui récupéré les valeurs de l'enregistrement trouver avec le critère combobox1
        1. yg_be Contributeur
          je pense que tu peux faire ainsi pour peupler la combobox: 
          rs.MoveFirst
Do While Not rs.EOF
    combobox1.AddItem rs!Materiel
    rs.MoveNext
Loop
      6. pyrus2047 Auteur
        j'ai ca qui fonctionne très bien mais je sais pas l’adapter a mon besoin 

        Sub Connecte_base_Access()
            Dim rs As Object
            Dim Nom_Base, Chemin_Base, Sql, Admin, Uid, pwd, ExtendedAnsiSQL ', connstring
            
            Set conn = CreateObject("ADODB.Connection")
            Nom_Base = "table.accdb"
            Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base
            connstring = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Chemin_Base & ";Uid=Admin;Pwd=xxxxx;ExtendedAnsiSQL=1;"
            conn.Open connstring
        End Sub
        Sub Recherche_Infos_Affichage_LVW()
            Dim rs As Object
            Dim DT1, DT2
            Dim PartTxt, Sql, SQL1, n, L, c, D, e, NbF
        On Error Resume Next
            Set rs = CreateObject("ADODB.recordset")
            PartTxt = TextBox1
            
            Sql = "select * from [Materiel] where [xxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' or [xxxxxxx] like '%" & PartTxt & "%' or [xxxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%'"
            rs.Open Sql, conn, 3, 3
            If Not rs.EOF Then
                rs.MoveFirst
                NbF = rs.Fields.Count
                NbRecord = rs.RecordCount
                n = 1
                Do While Not rs.EOF
                    With ListView1
                        .ListItems.Add , , rs.Fields(0)
                        For L = 2 To NbF
                        
                            .ListItems(n).ListSubItems.Add , , rs.Fields(L - 1)
                        Next L
                        If .ListItems(n) = TextBox1 Then .ListItems(n).Bold = True
                        If .ListItems(n).ListSubItems(5).Text = "INDISPONIBLE" Then
                            .ListItems(n).Bold = True
                            .ListItems(n).ForeColor = vbRed
                            For c = 1 To .ColumnHeaders.Count - 1
                                .ListItems(n).ListSubItems(c).Bold = True
                                .ListItems(n).ListSubItems(c).ForeColor = vbRed     'couleur colonne 2
                            Next c
                            
                       Else
                       
                           If .ListItems(n).ListSubItems(5).Text = "DISPONIBLE" Then
                            .ListItems(n).Bold = True
                            .ListItems(n).ForeColor = vbGreen
                            For e = 1 To .ColumnHeaders.Count - 1
                                .ListItems(n).ListSubItems(e).Bold = True
                                .ListItems(n).ListSubItems(e).ForeColor = vbGreen     'couleur colonne 2
                            Next e
                        
                         Else
                        If .ListItems(N).ListSubItems(8).Text = "RESERVATION" Then
                            .ListItems(N).Bold = True
                            .ListItems(N).ForeColor = vbCyan
                            For d = 1 To .ColumnHeaders.Count - 1
                                .ListItems(N).ListSubItems(d).Bold = True
                                .ListItems(N).ListSubItems(d).ForeColor = vbCyan     'couleur colonne 2
                            Next d
                        End If
                        End If
                        End If
                    End With
                    n = n + 1
                    rs.MoveNext
                Loop
                Label2.Caption = NbRecord & " enregistrement(s) !"
            Else
                MsgBox "Attention: pas d'enregistrement trouvé!!"
            End If
            rs.Close
            Set rs = Nothing

        End Sub
        1.  yg_be Contributeur
          merci de spécifier "basic" quand tu utilises les balises de code pour partager du code.
          peux-tu préciser ce que tu voudrais obtenir de différent comme résultat?
          il suffit peut-être d'adapter ceci: 
          "select * from [Materiel] " _
    + " where [xxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%' " _
     + " or [xxxxxxx] like '%" & PartTxt & "%' or [xxxxxx] like '%" & PartTxt & "%' or [xxxxx] like '%" & PartTxt & "%'"
      7. pyrus2047 Auteur
        Oui
        1. yg_be Contributeur
          peux-tu les importer en utilisant VBA? il suffira peut-être de modifier le code pour importer à partir d'une requête SQL au lieu d'une table.

      Discussions similaires

      Quick Access service
      alain_1949

      4 réponses
      Table des matières dont les titres n'apparaissent pas..
      Synua

      10 réponses