Microsoft 365 Remplir une combobox à partir d'un autre fichier

gillmo

XLDnaute Occasionnel
bonjour,
je sais que ce sujet à déjà été traité plusieurs fois, j'ai récupérer un code sur un forum, qui devait normalement répondre à ma demande, à savoir remplir une combobox d'un formulaire avec les données présentes dans un autre fichier possiblement fermé.

Le soucis, c'est que j'obtiens une incompatibilité de type. J'ai exécuté le code pas à pas, et apparemment le soucis viendrait de la dernière ligne Get_Combo = Application.Transpose(RcdSt)

Je vous joint le code, pour l'instant sans fichier. A voir les discussions sur les différents forums, plusieurs personnes ont utilisé ce code sans soucis. Je pense donc que le problème vient peut être de l'utilisation que j'en fait dans mon useform

VB:
Option Explicit

Public Const NDF = "B:\Commun\Suivi des temps\Test\Parametrage.xlsx"


Private RcdSt() As Variant
Private Req As String


' *************************************************************************************************
Function Query(Req As String) As Long
Dim Cnx As Object, Rst As Object
Dim i As Long, j As Long

    On Error GoTo errhdlr

    Set Cnx = CreateObject("ADODB.Connection")
    Cnx.Provider = "MSDASQL"

    Cnx.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
             "DBQ=" & NDF & "; ReadOnly=False;"

    If Left(Req, 6) = "SELECT" Then
        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open Req, Cnx, 3

        Query = Rst.RecordCount
        If Not Query = 0 Then
            ReDim RcdSt(Rst.Fields.Count - 1, Query - 1)
            Rst.MoveFirst
            RcdSt = Rst.GetRows
            For i = 0 To UBound(RcdSt, 1) - 1
                For j = 0 To UBound(RcdSt, 2) - 1
                    If IsNull(RcdSt(i, j)) Then RcdSt(i, j) = ""
                Next j
            Next i
        End If
    Else
        Cnx.Execute Req
        Query = 0
    End If

    Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Exit Function

errhdlr:
    If Not Rst Is Nothing Then If Rst.State = 1 Then Rst.Close
    If Not Cnx Is Nothing Then If Cnx.State = 1 Then Cnx.Close
    Set Rst = Nothing
    Set Cnx = Nothing
    Query = -1
    MsgBox (err.description)
End Function


Function Get_Combo(Chps As String, Ong As String, Optional Cnd As String) As Variant()

    Req = "SELECT DISTINCT " & Chps & " FROM [" & Ong & "$]"

    If Not Cnd = "" Then Req = Req & " WHERE " & Cnd

    Req = Req & " ORDER BY " & Chps

    Erase Get_Combo
    If Query(Req) > 0 Then Get_Combo = Application.Transpose(RcdSt)

End Function

Merci pour le temps que vous allez bien vouloir me consacrer.
 

fanch55

XLDnaute Accro
Salut,
Tel quel, je ne vais pas pouvoir beaucoup t'aider,
ne sachant pas ce que contient ton fichier de paramétrage .
Il faudrait faire un point d'arrêt sur la ligne
If Query(Req) > 0 Then Get_Combo = Application.Transpose(RcdSt)
l'exécuter en pas à pas et tracer le contenu de Rcdst dans la fenêtre Espion.
 

gillmo

XLDnaute Occasionnel
Bonjour fanch,

comme tu me l'a conseillé, j'ai ajouté un espion, et Rcdst récupère bien des infos

1615814527541.png


Par contre, j'ai fait la même chose sur Get combo, et là j'ai plus de messages d'erreur, mais je ne sais pas lequel ou lesquels sont bloquant.

J'indique une partie des messages, car la liste est longue. Je ne sais pas si cela peut déjà te donner une piste


1615814789997.png


Merci de ton aide
 

fanch55

XLDnaute Accro
Pourrais-tu remplacer provisoirement la sub ci-dessous
VB:
Function Get_Combo(Chps As String, Ong As String, Optional Cnd As String) As Variant()

    Req = "SELECT DISTINCT " & Chps & " FROM [" & Ong & "$]"

    If Not Cnd = "" Then Req = Req & " WHERE " & Cnd

    Req = Req & " ORDER BY " & Chps

    Erase Get_Combo
      
    If Query(Req) > 0 Then
        On Error Resume Next
        Get_Combo = Application.Transpose(RcdSt)
        If Err.Number > 0 Then
            Debug.Print Err.Number, Err.Description
            Debug.Print "Req=" & Req
            Debug.Print "rcdst(" & UBound(RcdSt, 1) & "," & UBound(RcdSt, 2) & ")"
        End If
    End If
    
End Function
et me copier ce qui a été produit dans la fenêtre Exécution du VBE ?

Sinon, si tu pouvais fournir une version expurgée du classeur , ce serait bien plus facile à analyser .
 

fanch55

XLDnaute Accro
Après analyse et test des fichiers, recommandation :
Pour le get_Combo :
VB:
'        Get_Combo = Application.Transpose(RcdSt)
        Get_Combo = RcdSt
Pour l'userform :

Code:
Private Sub userform_initialize()
Dim temp()
Dim cell As Range
Me.StartUpPosition = 2
Application.Calculation = xlCalculationManual

' theme.List = Get_Combo("Themes", "Feuil1")
theme.Column = Get_Combo("Themes", "Feuil1")
 
'  With Sheets("parametrage")
'        For Each cell In .Range("d2:d" & .Range("d65536").End(xlUp).Row)
'             Me.theme.AddItem (cell)
'        Next
'        For Each cell In .Range("e2:e" & .Range("e65536").End(xlUp).Row)
'             Me.typeaction.AddItem (cell)
'        Next
'        For Each cell In .Range("f2:f" & .Range("f65536").End(xlUp).Row)
'             Me.section.AddItem (cell)
'        Next
'
'    End With
End Sub
( La feuille Parametrage n'existant pas dans le fichier expurgé )
 

gillmo

XLDnaute Occasionnel
Merci Fanch, ça fonctionne parfaitement.

Je souhaiterais aller plus loin, et remplir la textbox nom du collaborateur, en fonction de son matricule saisi dans la textbox matricule, en allant toujours chercher ces infos dans le fichier paramétrage.

cdlt.
 

fanch55

XLDnaute Accro
Bonsoir,
Les sub existantes ne permettent pas facilement de faire ce que vous voulez, surtout s'il n'y a pas de concordance.
J'ai rajouté ma sub personnelle dans le module Module1.
J'ai remplacé la textbox matricule par une combobox.
Ci-joint les fichiers modifiés, analysez les .
 

Pièces jointes

  • Parametrage.xlsx
    9.8 KB · Affichages: 9
  • Test.xlsm
    45.9 KB · Affichages: 13

gillmo

XLDnaute Occasionnel
Bonjour,

Merci Fanch pour avoir tenté de répondre à ma demande, en fait je voulais remplir automatiquement la zone nom du collaborateur en fonction de son matricule, tout en allant chercher les infos dans une feuille extérieur afin d'avoir à gérer une seule liste et non pas sur chaque fichier.

Je vais gérer la liste dans chaque fichier, ce sera plus simple en attendant de trouver une autre solution

Merci.
 

gillmo

XLDnaute Occasionnel
Bonjour,

Désolé pour le retard de réponse, j'ai été pris par d'autres demandes urgentes au boulot.
Pour te répondre Fanch, oui le fichier test répond à la demande, seulement je ne souhaite pas que textbox matricule devienne une combobox, je ne veux pas donner le choix à l'utilisateur de choisir un matricule.

Pour l'instant, ce dossier est en standby, j'attends la décision des chefs.

Je reviendrai surement si ça se décante. Merci pour ton aide précieuse.
 
Haut Bas