OVH Cloud OVH Cloud

tri et doublons (code)

1 réponse
Avatar
srogeau
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

1 réponse

Avatar
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