ce code marche parfaitement dans l'exemple de denismichon
userform:
Private Sub userform_Initialize()
Dim Rg As Range, Fichier As Workbook, Lig As Long
Set Fichier = ThisWorkbook
'Ouvrir Connection
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""
With Worksheets("ma base")
For A = 1 To 4 ' 4 colonnes
Lig = .Cells(65536, A).End(xlUp).Row
Set Rg = Range(.Cells(1, A), .Cells(Lig, A))
Controls("ComboBox" & A).List = MaListe(Rg, Fichier)
Next
End With
Set Fichier = Nothing: Set Rg = Nothing
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
For A = 1 To 4
Controls("combobox" & A).Clear
Next
End Sub
module:
Public Conn As ADODB.Connection, Rst As New ADODB.Recordset
Sub ouvrirformulaire()
userform2.Show
End Sub
Public Function MaListe(Rg As Range, Fichier As Workbook)
Dim Requete As String, NomColonne As String
Rg.Name = Rg(1, 1).Text
NomColonne = Fichier.Names(Rg(1, 1).Text).Name
Requete = "SELECT " & NomColonne & " From " & NomColonne & "" _
& vbCrLf & "Where " & NomColonne & " <> Null " & vbCrLf & _
"Group By " & NomColonne & " ORDER By " & NomColonne & ""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
MaListe = Application.Transpose(Rst.GetRows)
ThisWorkbook.Names(Rg(1, 1).Text).Delete
Rst.Close
End Function
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
michdenis
Bonjour Srogeau,
Bien que ce code soit dans le formulaire, cette section n'est pas pertinente pour la donne du problème
'----------------- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) For A = 1 To 4 Controls("combobox" & A).Clear Next End Sub '-----------------
Et tu as omis de dire que si quelque veut utiliser ce type de code, il doit ajouter la référence :
"Microsoft activex data object 2.0 librairy"
Salutations!
"Srogeau" a écrit dans le message de news: ce code marche parfaitement dans l'exemple de denismichon userform: Private Sub userform_Initialize() Dim Rg As Range, Fichier As Workbook, Lig As Long Set Fichier = ThisWorkbook 'Ouvrir Connection Set Conn = New ADODB.Connection Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Fichier.FullName & ";" & _ "Extended Properties=""Excel 8.0;HDR=Yes;""" With Worksheets("ma base") For A = 1 To 4 ' 4 colonnes Lig = .Cells(65536, A).End(xlUp).Row Set Rg = Range(.Cells(1, A), .Cells(Lig, A)) Controls("ComboBox" & A).List = MaListe(Rg, Fichier) Next End With
Set Fichier = Nothing: Set Rg = Nothing Conn.Close Set Rst = Nothing: Set Conn = Nothing End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) For A = 1 To 4 Controls("combobox" & A).Clear Next End Sub module: Public Conn As ADODB.Connection, Rst As New ADODB.Recordset
Sub ouvrirformulaire() userform2.Show End Sub
Public Function MaListe(Rg As Range, Fichier As Workbook) Dim Requete As String, NomColonne As String Rg.Name = Rg(1, 1).Text NomColonne = Fichier.Names(Rg(1, 1).Text).Name Requete = "SELECT " & NomColonne & " From " & NomColonne & "" _ & vbCrLf & "Where " & NomColonne & " <> Null " & vbCrLf & _ "Group By " & NomColonne & " ORDER By " & NomColonne & "" Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic MaListe = Application.Transpose(Rst.GetRows) ThisWorkbook.Names(Rg(1, 1).Text).Delete Rst.Close End Function
Bonjour Srogeau,
Bien que ce code soit dans le formulaire, cette section n'est pas pertinente pour la donne du problème
'-----------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
For A = 1 To 4
Controls("combobox" & A).Clear
Next
End Sub
'-----------------
Et tu as omis de dire que si quelque veut utiliser ce type de code, il doit ajouter la référence :
"Microsoft activex data object 2.0 librairy"
Salutations!
"Srogeau" <srogeau@aol.com> a écrit dans le message de news:20040610170007.05521.00000678@mb-m17.aol.com...
ce code marche parfaitement dans l'exemple de denismichon
userform:
Private Sub userform_Initialize()
Dim Rg As Range, Fichier As Workbook, Lig As Long
Set Fichier = ThisWorkbook
'Ouvrir Connection
Set Conn = New ADODB.Connection
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier.FullName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"""
With Worksheets("ma base")
For A = 1 To 4 ' 4 colonnes
Lig = .Cells(65536, A).End(xlUp).Row
Set Rg = Range(.Cells(1, A), .Cells(Lig, A))
Controls("ComboBox" & A).List = MaListe(Rg, Fichier)
Next
End With
Set Fichier = Nothing: Set Rg = Nothing
Conn.Close
Set Rst = Nothing: Set Conn = Nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
For A = 1 To 4
Controls("combobox" & A).Clear
Next
End Sub
module:
Public Conn As ADODB.Connection, Rst As New ADODB.Recordset
Sub ouvrirformulaire()
userform2.Show
End Sub
Public Function MaListe(Rg As Range, Fichier As Workbook)
Dim Requete As String, NomColonne As String
Rg.Name = Rg(1, 1).Text
NomColonne = Fichier.Names(Rg(1, 1).Text).Name
Requete = "SELECT " & NomColonne & " From " & NomColonne & "" _
& vbCrLf & "Where " & NomColonne & " <> Null " & vbCrLf & _
"Group By " & NomColonne & " ORDER By " & NomColonne & ""
Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic
MaListe = Application.Transpose(Rst.GetRows)
ThisWorkbook.Names(Rg(1, 1).Text).Delete
Rst.Close
End Function
Bien que ce code soit dans le formulaire, cette section n'est pas pertinente pour la donne du problème
'----------------- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) For A = 1 To 4 Controls("combobox" & A).Clear Next End Sub '-----------------
Et tu as omis de dire que si quelque veut utiliser ce type de code, il doit ajouter la référence :
"Microsoft activex data object 2.0 librairy"
Salutations!
"Srogeau" a écrit dans le message de news: ce code marche parfaitement dans l'exemple de denismichon userform: Private Sub userform_Initialize() Dim Rg As Range, Fichier As Workbook, Lig As Long Set Fichier = ThisWorkbook 'Ouvrir Connection Set Conn = New ADODB.Connection Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & Fichier.FullName & ";" & _ "Extended Properties=""Excel 8.0;HDR=Yes;""" With Worksheets("ma base") For A = 1 To 4 ' 4 colonnes Lig = .Cells(65536, A).End(xlUp).Row Set Rg = Range(.Cells(1, A), .Cells(Lig, A)) Controls("ComboBox" & A).List = MaListe(Rg, Fichier) Next End With
Set Fichier = Nothing: Set Rg = Nothing Conn.Close Set Rst = Nothing: Set Conn = Nothing End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) For A = 1 To 4 Controls("combobox" & A).Clear Next End Sub module: Public Conn As ADODB.Connection, Rst As New ADODB.Recordset
Sub ouvrirformulaire() userform2.Show End Sub
Public Function MaListe(Rg As Range, Fichier As Workbook) Dim Requete As String, NomColonne As String Rg.Name = Rg(1, 1).Text NomColonne = Fichier.Names(Rg(1, 1).Text).Name Requete = "SELECT " & NomColonne & " From " & NomColonne & "" _ & vbCrLf & "Where " & NomColonne & " <> Null " & vbCrLf & _ "Group By " & NomColonne & " ORDER By " & NomColonne & "" Rst.Open Requete, Conn, adOpenForwardOnly, adLockOptimistic MaListe = Application.Transpose(Rst.GetRows) ThisWorkbook.Names(Rg(1, 1).Text).Delete Rst.Close End Function