Combobox excel critère rechercheV dans table Runtime Access

pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention   -  
yg_be Messages postés 23541 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
A voir également:

15 réponses

Réponse 1 / 15
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
bonjour, peux-tu importer des données Access dans Excel?
0
Réponse 2 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
Oui
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
Réponse 3 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
Réponse 4 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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

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

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

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

https://www.cjoint.com/c/JCzvNEBW7Pe
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
Réponse 9 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour
désolé c'est la colonne module que j'ai oublié de renommée Matériel
0
Réponse 10 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
as-tu essayé 
textbox1=combobox1
?
0
Réponse 11 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
Réponse 12 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
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
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention   > yg_be Messages postés 23541 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
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584 > pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
si tu es débutant et que tu veux progresser, prends le temps de réfléchir et de chercher.
0
Réponse 13 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
ok merci cet appel au secoure c' est pour gagné du temps
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
cela fait plusieurs années que tu débutes, tu gagneras plus de temps en progressant.
dans quel contexte fais-tu ce travail?
0
Réponse 14 / 15
pyrus2047 Messages postés 153 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour
merci je vais me débrouiller
Cordialement
0
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   1 584
 
si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?
0
Réponse 15 / 15
yg_be Messages postés 23541 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 584
 
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
Intégrer une table des annexes et des matières sur word
clairon69 -
Jo -

20 réponses