Combobox excel critère rechercheV dans table Runtime Access

pyrus2047 Messages postés 156 Statut Membre -  
yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   -
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

  1.
    yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, peux-tu importer des données Access dans Excel?
    0
  2. pyrus2047 Messages postés 156 Statut Membre
     
    Oui
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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.
      0
  3. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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 & "%'"
      0
  4. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. pyrus2047 Messages postés 156 Statut Membre
     
    Ca ne fonctionne pas
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      "Ca ne fonctionne pas": partage ton code, décris le symptôme.
      0
  7. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      tu 'as pas utilisé ma suggestion.
      0
  8. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      pourrais-tu partager tes deux fichiers?
      0
  9. pyrus2047 Messages postés 156 Statut Membre
     
    Voici les fichier

    https://www.cjoint.com/c/JCzvLvCmaFe

    https://www.cjoint.com/c/JCzvNEBW7Pe
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      la ligne 
      On Error Resume Next
      cache les erreurs, il est préférable de la supprimer.
      contrairement à ce que tu as écrit en #6, il n'y a pas de colonne"Materiel" dans la table Access.
      0
  10. pyrus2047 Messages postés 156 Statut Membre
     
    Bonjour
    désolé c'est la colonne module que j'ai oublié de renommée Matériel
    0
  11. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      as-tu essayé 
      textbox1=combobox1
      ?
      0
  12. pyrus2047 Messages postés 156 Statut Membre
     
    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
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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?
      0
  13. pyrus2047 Messages postés 156 Statut Membre
     
    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) & ";"
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      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?
      0
      1. pyrus2047 Messages postés 156 Statut Membre > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        Je ne sais pas j'ai tanté d'adapter cette ligne j'ai récupéré d'un autre projet je suis débutant
        0
      2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > pyrus2047 Messages postés 156 Statut Membre
         
        si tu es débutant et que tu veux progresser, prends le temps de réfléchir et de chercher.
        0
  14. pyrus2047 Messages postés 156 Statut Membre
     
    ok merci cet appel au secoure c' est pour gagné du temps
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      cela fait plusieurs années que tu débutes, tu gagneras plus de temps en progressant.
      dans quel contexte fais-tu ce travail?
      0
  15. pyrus2047 Messages postés 156 Statut Membre
     
    Bonjour
    merci je vais me débrouiller
    Cordialement
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?
      0
  16. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?
    0

Discussions similaires

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

10 réponses