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

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
    bonjour, peux-tu importer des données Access dans Excel?
    1. 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.
    2. 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 & "%'"
    3. 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
    5. pyrus2047 Auteur
      Ca ne fonctionne pas
      1. yg_be Contributeur
        "Ca ne fonctionne pas": partage ton code, décris le symptôme.
    6. 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.
    7. 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?
    9. pyrus2047 Auteur
      Bonjour
      désolé c'est la colonne module que j'ai oublié de renommée Matériel
      1. 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
          ?
      2. 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?
      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.
      4. 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?
      5. 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?
      6. yg_be Contributeur
        si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?

        Discussions similaires

        Table des matières dont les titres n'apparaissent pas..
        Synua

        10 réponses
        Quick Access service
        alain_1949

        4 réponses