XL 2019 Combobox à partir d'un fichier fermé

[gui64600]

Bonjour,
Jai un fichier source.xlsm qui en colonne A de la feuille "source" contient des noms.
Je voudrais dans un autre fichier résultat.xlsm créer une combobox me permettant une saisie semi-automatique des noms du fichier source en cellule C2

Le fichier A est fermé.

Merci de votre aide

 

[Dudu2]

Bonjour,
Je récupère des codes divers trouvés ici ou là pour faire une fonction que fait ça avec du SQL, car je n'ai trouvé que ça.
La difficulté avec cette requête "SQL SELECT * FROM" c'est qu'elle retourne un peu ce qu'elle veut et considère la 1ère ligne comme le nom des champs qu'elle ne rend pas et qu'il faut donc récupérer séparément et que si il n'y a que la 1ère ligne on ne récupère rien.
Je vais essayer de couvrir tous les cas et je posterai le fichier.

Sinon, si tu n'as pas trop de noms en colonne A de ton classeur fermé tu peux toujours tenter de récupérer cellule par cellule avec ce code:

Sub TestExtraireValeur()
    MsgBox ExtraireValeur("H:\Téléchargements", "Classeur2.xlsx", "Feuil1", "A3")
End Sub

Function ExtraireValeur(ByVal Dossier As String, ByVal Fichier As String, ByVal Feuille As String, ByVal Cellule As String) As Variant
    Dim Argument As String
   
    If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
    Fichier = Replace(Fichier, "'", "''")
    Argument = "'" & Dossier & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Address(, , xlR1C1)
    'MsgBox Argument
    ExtraireValeur = ExecuteExcel4Macro(Argument)
End Function

 

[patricktoulon]

bonjour @Dudu2 @gui64600
comme ça vite fait, une petite démo avec ado
un fichier démo et une base xlsx
je récupère la colonne "A" du fichier "base.xlsx" dans la combobox dans la feuille 1 du fichier démo
normalement c'est quasiment instantané

 

[patricktoulon]

re
a oui j'oubliais si ta liste deroulante est une liste de validation

 tbl = resADO([A1:C20], fichier, nomfeuille)
   '' ActiveSheet.ComboBox1.List = tbl
    With ActiveSheet.Range("A2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(Application.Transpose(tbl), ",")
    End With

et pour repondre a @Dudu2
l'argument HDR ="no" prend la première occurrence comme la première et non un nom de champ
et pour les différence de données dans une meme colonnes qui peuvent générer des erreurs imex=1 permet de récupérer tout au format text

 

[Dudu2]

Salut PatrickToulon,

et pour repondre a @Dudu2
l'argument HDR ="no" prend la première occurrence comme la première et non un nom de champ

Ok merci pour le tuyau

 

[Dudu2]

Pour le Application.Transpose, il me semble avoir eu des problèmes au-delà de 41248 éléments de tableau. Faut que je vérifie.

 

[patricktoulon]

j'avais oublié aussi que ado et son .execute n'aime pas les lignes vides et génère une erreur
donc si il y en a
il faut donc passer par la lecture du recordset
seul petit bémol cette fois ci même si ado et en latebinding(createobject) dans le code ci dessous il faut activer quand même la librairie "microsoft Activx Data object 2.0 library"
dans l'exemple ci dessous on bouclera donc sur tout le recorset (il y en a autant que de ligne vides dans la colonnes source

allez c'est parti on récupere la colonne "A" dans base.xlsx sans les vides
hdr est piloté par l'appel dans cet exemple

Sub test_récup_plage()
    Dim fichier$, Tbl
    fichier = ThisWorkbook.Path & "\BASE.xlsx"    'à adapter
    Tbl = GetcolumnValueOnClosedWbookskeepblank(fichier, "A1:A20", "Feuil1", False)
    'Sheets("Feuil2").[A1].Resize(UBound(Tbl)) = Tbl
      With ActiveSheet.ComboBox1: .Clear: .List = Tbl: End With
End Sub

Function GetcolumnValueOnClosedWbookskeepblank(fichier As String, RnG As String, Feuille As string, Optional headerTable As Boolean = False)
    Dim AdConn As Object, AdoComand As Object, HDR$, RsT As Object, RsTLigne&, RsTCol&, v$, Arr()
    Set AdConn = CreateObject("ADODB.Connection")
    Set AdoComand = CreateObject("ADODB.Command")
    Set RsT = CreateObject("ADODB.RecordSet")
    HDR = Array("No", "Yes")(Abs(headerTable))
    AdConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=" & HDR & ";IMEX=1"";"
    AdoComand.ActiveConnection = AdConn
    AdoComand.CommandText = "SELECT * from `" & Feuille & "$" & RnG & "`"
    RsT.Open AdoComand, , adOpenKeyset  ', adLockOptimistic
        RsT.MoveFirst
    Do While Not RsT.EOF
        For RsTLigne = 1 To RsT.RecordCount  'lignes
            If Not IsNull(RsT.Fields(0).Value) Then A = A + 1: ReDim Preserve Arr(1 To A): Arr(A) = RsT.Fields(0).Value
            RsT.MoveNext
        Next
    Loop
    AdConn.Close: Set RsT = Nothing: Set AdoComand = Nothing: Set AdConn = Nothing
    GetcolumnValueOnClosedWbookskeepblank = Application.Transpose(Arr)
End Function

avec ça on englobe pas mal d'erreurs qui sont souvent incompréhensible avec ADO
enjoy

 

[Dudu2]

Ton code est vraiment très expert !
A force de mélanger les sources j'ai pu faire une fonction de récupération:
- Soit d'une plage
- Soit d'une feuille
Il y a des tas de façons proposées ici et là de faire la connexion et je n'y comprends pas grand chose. J'ai pris ta méthode avec le HDR=NO qui a réglé mon problème de 1ère ligne.
Dans le tableau Variant en retour, j'ai gardé le type des valeurs en n'utilisant pas imex=1.

Ça marche très bien pour la récupération d'une plage.
En récupération de la feuille ça marche aussi sauf quand il y a des lignes vides en haut et/ou des colonnes vides à gauches car elles ne sont pas récupérées par SQL. Faut faire avec !

Un fichier juste à titre d'essai.

Edit: Modifié le 06/12/2020 à 06h36 pour proposer 2 fonctions:
- Une fonction qui retourne les valeurs Texte issues du SQL en tableau
- Une fonction qui charge un Range à partir des valeurs Texte issues du SQL et qui donne aux cellules du Range un format (autant que possible) correspondant au type de leurs valeurs (date, nombre, % etc...)

 

[patricktoulon]

oui dans tout ce fouilli que tu trouve il y a deux methodes
soit l'object ado open puis .execute
soit le recordset.open(la commandtext de la command de Ado) qui permet de lire jusqu'a EOF
la méthode utilisée dépend du besoins

si tu veux copier une feuille (son usedrange) passe par la première avec .CopyFromRecordset c'est plus simple et en late binding comme ça on active pas la ref activX Data

vite fait à l'arrache comme ceci (change le chemin du fichier )

Sub msj(fichier$)
    Dim Ado As Object, texte_SQL$, AdoReQ As Object
      Set Ado = CreateObject("ADODB.Connection")    'instance d'ado
    With Ado    'Ado Connexion
         .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & fichier & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"""
        .Open
    End With
    texte_SQL = "select * from [feuil1$]" 'adapter le non de la feuill si besoins
    'Set AdoReQ = CreateObject("ADODB.Recordset")
    Set AdoReQ = Ado.Execute(texte_SQL)
     Sheets("Feuil1").[A1].CopyFromRecordset AdoReQ  'inscrisption du return de AdoReQ a la suite dans le sheets
       Ado.Close
    Set Ado = Nothing
End Sub

Sub lance()
Dim fichier$
fichier = "C:\Users\polux\DeskTop\Base.xlsx"    'chemin du  classeur fermé servant de base de données
msj fichier
End Sub

enjoy

 

[patricktoulon]

re
pour les lignes vides en haut ou colonnes vides à gauche c'est normal Ado récupère pas les lignes vides il récupère ce qui correspond au usedrange

 

[Dudu2]

Ado récupère pas les lignes vides il récupère ce qui correspond au usedrange

Correct, c'est bien ça. Cet Ado manque de maturité

Du coup j'ai renommé le fichier du post #8 en:
"VBA Lire plage ou UsedRange d'une feuillle d'un classeur fermé.xlsm"

 

[patricktoulon]

re
a oui le jeu de mot.. bien
ben maintenant tu en sais un peu plus c'est beau la vie non ?
il faudra expliquer tout ça au demandeur on c'est un peu envoler tout les deux

 

[Dudu2]

Tu as raison, faut revenir sur terre

.
Et donc après ta proposition, en voici une autre pour le chargement de la ComboBox.

 

[patricktoulon]

non ca fonctionne pas ton model combo elle reste vide

 

[patricktoulon]

non c'est bon ca marche mais tu ne supprime pas les lignes vides