Combobox excel critère rechercheV dans table Runtime Access

Signaler
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020
-
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
-
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

14 réponses

Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
bonjour, peux-tu importer des données Access dans Excel?
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

Oui
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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.
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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 & "%'"
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

Ca ne fonctionne pas
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
"Ca ne fonctionne pas": partage ton code, décris le symptôme.
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
tu 'as pas utilisé ma suggestion.
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
pourrais-tu partager tes deux fichiers?
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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.
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

Bonjour
désolé c'est la colonne module que j'ai oublié de renommée Matériel
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
as-tu essayé
textbox1=combobox1
?
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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?
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

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) & ";"
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
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?
pyrus2047
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020
> yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020

Je ne sais pas j'ai tanté d'adapter cette ligne j'ai récupéré d'un autre projet je suis débutant
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585 > pyrus2047
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

si tu es débutant et que tu veux progresser, prends le temps de réfléchir et de chercher.
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

ok merci cet appel au secoure c' est pour gagné du temps
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
cela fait plusieurs années que tu débutes, tu gagneras plus de temps en progressant.
dans quel contexte fais-tu ce travail?
Messages postés
140
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
30 mars 2020

Bonjour
merci je vais me débrouiller
Cordialement
yg_be
Messages postés
10378
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
6 avril 2020
585
si tu n'as pas d'autre question, peux-tu marquer cette discussion comme résolue?