Userform avec données externes fichier fermé (ADO)

[pmfontaine]

Bonjour,
Je cherche le code pour lié un userform avec une base de données externe (fichier excel qui reste fermé)
Sur http://boisgontierjacques.free.fr/pages_site/ado.htm#CopyFrom j'ai trouvé des pistes avec ADO, mais je ne suis pas arrivé à les utiliser.
Je précise que les combobox sont liés (Grasse à ce forum et en particulier à Dranreb)

Sur le fichier joint FICHIER_DESTINATION.xlsm je souhaiterais que la table TabEspGlo qui est sur la page SOURCE soit sur un autre fichier BD_SOURCE.xlsx qui sera dans le même dossier et qui restera fermé grasse à ADO si j'ai bien compris le site de boisgontier Jacques.
(NB : La table TabEspGlo comporte plus de 220 000 lignes)
Merci d'avance pour votre aide
Patrick

 

[Lone-wolf]

Re

Au cas ou tu ne voudrais pas supprimer les macros que Dranreb a fait.

 

[pmfontaine]

En partant de mes deux fichiers joints à mon premier massage il n'y a pas de soucis pourvu que les combobox restent liées.
Pour info, aucun problème, chez moi, pour afficher les combobox-liées avec 220 000 lignes en sources (il faut quand même quelques secondes)
Merci

 

[Lone-wolf]

Bonsoir Patrick, le Forum

Une autre façon de faire sans ADO. J'ai créé un nouveau formulaire.
Double-clique sur la feuille du classeur Destination pour afficher celui-ci.
Fait un test avec les combos puis clique sur le bouton pour fermer.

 

[pmfontaine]

Bonjour Lone-wolf, bonjour le forum
Merci Lone-wolf pour cette nouvelle proposition. Mais ça ne fonctionne pas avec les combobosliées auxquels je tiens absolument.

J'ai effectivement pensé à passer via table vba ou dico mais je ne sais pas l'utilisé avec les conboboxliées.
J'ai fait ce code avec ouverture de la source pour mettre a jour la table (8 s) je pourais faire avec.

Sub MiseAJourBD()
   'Sauvegarde du nom du classeur actif
    Nom_Maitre = ActiveWorkbook.Name
    Workbooks(Nom_Maitre).Activate
    Sheets("SOURCE").Select
    MonFichier = ThisWorkbook.Path & "\BD_SOURCE.xlsx"
'Teste si fichier BD_SOURCE.xlsx est présent
If FichierExiste(MonFichier) = True Then
    Workbooks.Open Filename:=ThisWorkbook.Path & "\BD_SOURCE.xlsx"

    With Sheets("SOURCE")
    tabloBD = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 4)
    End With
    Windows("BD_SOURCE.xlsx").Close SaveChanges:=False
    Workbooks(Nom_Maitre).Activate
    With Sheets("SOURCE")
        Cells(2, 1).Resize(UBound(tabloBD, 1), 4).Value = tabloBD
    End With
Else
MsgBox "Le fichier BD_SOURCE.xlsx est absent, la Base de Données ne sera pas mise a jour."
End If
End Sub
Public Function FichierExiste(MonFichier As String)
   If Len(Dir(MonFichier)) > 0 Then
      FichierExiste = True
   Else
      FichierExiste = False
   End If
End Function

Aprés, le problème c'est le temps d'ouverture de l'userform.
Ma réflexion est :

1 - Peut-on créer "tabloBD = .Cells(2, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 4)" sans ouvrir le fichier source avec ADO si oui comment et est-ce que j'aurais un gain de temps ?

2 - Comment alimenter des conboboxliées a partir d'un tableau vba (tabloBD)
un truc du genre (Celui là ne fonctionne pas bien sur)

Private Sub UserForm_Initialize()
Nom_Maitre = ActiveWorkbook.Name
    Workbooks(Nom_Maitre).Activate
    MonFichier = ThisWorkbook.Path & "\BD_SOURCE.xlsx"
    Workbooks.Open Filename:=ThisWorkbook.Path & "\BD_SOURCE.xlsx"

    With Sheets("SOURCE")
    tabloBD = .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 4)
    End With
    Windows("BD_SOURCE.xlsx").Close SaveChanges:=False
    Workbooks(Nom_Maitre).Activate
 
Set Ajt = New ComboBoxLiées
Ajt.plage [tabloBD]
Ajt.Add CBxAjouOrdre, tabloBD(1, 1)
Ajt.Add CBxAjouNomVerna, tabloBD(1, 2)
Ajt.Add CBxAjouNomLatin, tabloBD(1, 3)
Ajt.Add CBxAjouCD_NOM, tabloBD(1, 4)

'Code d'origine
'Sheets("ESPECES").Select
'Set Ajt = New ComboBoxLiées
'Ajt.plage [TabEspGlo]
'Ajt.Add CBxAjouOrdre, "Classe"
'Ajt.Add CBxAjouNomVerna, "Nom vernaculaire"
'Ajt.Add CBxAjouNomLatin, "Nom latin"
'Ajt.Add CBxAjouCD_NOM, "CD_NOM"

Ajt.Actualiser
End Sub

Je ferais un MP à à Dranreb et à boisgontier Jacques en début de semaine prochaine (il n'y à rien d'urgent) pour savoir si il y à une solution (Je suppose que le MP est possible sur le forum ? j'en n'ai jamais envoyé)
Bon WE à tous
Patrick

 

[Lone-wolf]

Re

@pmfontaine

Patrick. Faut ouvrir les yeux. Si tu regarde la macro, elle ouvre le fichier "source.xlsx" et le masque.
Les combobox sont liées, si tu sait lire les macros.
La 1ère est remplie avec la colonne A et sans doublons - la 2ème affiche les lignes qui sont en rapport avec le choix de la 1ère combo et ainsi de suite. Si ce ne sont pas des combos liées, faut arrêter la programmation mon grand.

Dim Wks As Workbook, Twb As Workbook, ShS As Worksheet, Sh As Worksheet, _
fichier$, dico As Object, i&, Tbl, rw

Private Sub UserForm_Initialize()
    fichier = ThisWorkbook.Path & "\BD_SOURCE.xlsx"

    Set Wks = Workbooks.Open(fichier)
    Windows("BD_SOURCE.xlsx").Visible = False
    Set ShS = Wks.Sheets("SOURCE")

    Set Twb = ThisWorkbook
    Set Sh = Twb.Sheets("SOURCE")

    Tbl = Sh.UsedRange
    Set dico = CreateObject("Scripting.Dictionary")

    For i = 2 To UBound(Tbl)
        tablo = Tbl(i, 1)
        dico(tablo) = tablo
    Next i

    ComboBox1.List = dico.Items

End Sub

Private Sub ComboBox1_Change()
    If ComboBox1 <> "" Then cmb1
End Sub
Private Sub ComboBox2_Change()
    If ComboBox2 <> "" Then cmb2
End Sub
Private Sub ComboBox3_Change()
    If ComboBox3 <> "" Then cmb3
End Sub

Private Sub cmb1()
    Tbl = Sh.UsedRange
    ComboBox2.Clear
    For i = 2 To UBound(Tbl)
        If Left(Tbl(i, 1), 4) = Left(ComboBox1, 4) Then ComboBox2.AddItem Tbl(i, 2)
    Next i
End Sub

Private Sub cmb2()
    Tbl = Sh.UsedRange
    ComboBox3.Clear
    rw = Application.Match(ComboBox2, Sh.Columns(2), 0)
    ComboBox3.AddItem Sh.Cells(rw, 3)
End Sub

Private Sub cmb3()
    ComboBox4.Clear
    rw = Application.Match(ComboBox3, Sh.Columns(3), 0)
    ComboBox4.AddItem Sh.Cells(rw, 4)
End Sub

Private Sub CmdSave_Click()
Dim lig&, ShD As Worksheet

Set ShD = Twb.Sheets("DESTINATION")

    With ShD
        lig = .Range("a" & Rows.Count).End(3).Row + 1
        .Cells(lig, 1) = ComboBox1
        .Cells(lig, 2) = ComboBox2
        .Cells(lig, 3) = ComboBox3
        .Cells(lig, 4) = ComboBox4
    End With
   
    For i = 1 To 4
       Controls("Combobox" & i) = ""
    Next i
End Sub

Private Sub CmdFermer_Click()
    Windows("BD_SOURCE.xlsx").Close True
    Unload Me
End Sub

 

[Dranreb]

Bonjour.
Information: Il est possible de contourner la constitution automatique par un ComboBoxLiées des SujetBdD des ComboBoxMmbr à partir d'une plage. Il suffit de ne pas spécifier de colonne au Add de la ComboBox. Lors du Actualiser cela déclenchera un évènement SujBdDPersoSVP. Le Sujet peut être constitué par la fonction SujetCBx à partir de la colonne 1 d'un tableau VBA.

 

[pmfontaine]

Bonjour, Dranreb, bonjour Lone-wolf, bonjour le forum
Merci pour vos réponses :

Lone-wolf :

Patrick. Faut ouvrir les yeux. Si tu regarde la macro, elle ouvre le fichier "source.xlsx" et le masque.
Les combobox sont liées, si tu sait lire les macros.

Désolé, mais mes yeux sont trés grand ouverts, et pour moi, ta proposition n'est pas avec des comboboxLiées comme le fait les Combobox_Liées de de Dranreb. Les tiens sont en cascade, il faut saisir 1, puis 2 puis 3 etc. Avec le module de Dranreb, tu commence par n'importe lequel et pour mon utilisation c'est parfait (Regarde le fichier FICHIER_DESTINATION.xlsm qui est dans mon premier mésage et tu verra la diference.
Cela dit, j'apprécie beaucoup ton aide.

Dranreb,

Bonjour.
Information: Il est possible de contourner la constitution automatique par un ComboBoxLiées des SujetBdD des ComboBoxMmbr à partir d'une plage. Il suffit de ne pas spécifier de colonne au Add de la ComboBox. Lors du Actualiser cela déclenchera un évènement SujBdDPersoSVP. Le Sujet peut être constitué par la fonction SujetCBx à partir de la colonne 1 d'un tableau VBA.

Super, merci pour cette cette réponse qui me donne l’espoir d'aboutir à une solution.
Mon niveau de VBA n'est surement pas suffisant pour que je me débrouille tous seul, mais comme il n'y a pas d'urgence, je vais chercher le code seul et si dans 1 jour ou 2 je patauge trop je reviendrais vers vous pour vous demander de l'aide.

Merci et bon dimanche à tous
Patrick

 

[pmfontaine]

Bonjour,
Comme je m'en douté, je patauge, ou plutôt je me noie. Il faut dire que ce type de code est d'un niveau de pro et je ne suis qu'un amateur occasionnel
J'ai chercher sur le Web des exemples pour essayer de comprendre et d'adapter mais je n'ai rien trouvé.
Dranreb, est-ce que je peux avoir votre aide pour coder votre proposition sur le fichier joint ?
Merci
Patrick

 

[Dranreb]

Bonjour.
Cette procédure effectue l’initialisation des SujetBdD des ComboBoxMmbr si les colonnes ne sont plus indiquées aux Add :

Private Sub Ajt_SujBdDPersoSVP(ByVal CBM As ComboBoxMmbr)
Select Case True
   Case CBM.CBx Is CBxAjouOrdre: CBM.SujetBdD = SujetCBx([TabEspGlo[Classe]].Value)
   Case CBM.CBx Is CBxAjouNomVerna: CBM.SujetBdD = SujetCBx([TabEspGlo[Nom vernaculaire]].Value)
   Case CBM.CBx Is CBxAjouNomLatin: CBM.SujetBdD = SujetCBx([TabEspGlo[Nom latin]].Value)
   Case CBM.CBx Is CBxAjouCD_NOM: CBM.SujetBdD = SujetCBx([TabEspGlo[CD_NOM]].Value)
   End Select
End Sub

Du coup la Ajt.Plage [TabEspGlo] n'est plus nécessaire dans l'UserForm_Initialize

 

[pmfontaine]

Bonjour Dranreb,
Merci pour ta réponse, mais je ne sais pas modifier UserForm_Initialize pour que ça fonctionne.
Patrick

 

[Dranreb]

N'enfin ! Appliquer ce que je dis, mis en commentaire l'appel à la méthode Plage et les spécifications de colonnes :

'Ajt.plage [TabEspGlo]  plus besoin
Ajt.Add CBxAjouOrdre ', "Classe"
Ajt.Add CBxAjouNomVerna ', "Nom vernaculaire"
Ajt.Add CBxAjouNomLatin ', "Nom latin"
Ajt.Add CBxAjouCD_NOM ', "CD_NOM"
Ajt.Actualiser

 

[pmfontaine]

Désolé, mais j'avais fais une erreur, j'avais effacé involontairement "Set Ajt = New ComboBoxLiées"

Maintenant je vois quand temps d'ouverture ça ne change rien.

Question :
Dans :

Private Sub Ajt_SujBdDPersoSVP(ByVal CBM As ComboBoxMmbr)
Select Case True
   Case CBM.CBx Is CBxAjouOrdre: CBM.SujetBdD = SujetCBx([TabEspGlo[Classe]].Value)
   Case CBM.CBx Is CBxAjouNomVerna: CBM.SujetBdD = SujetCBx([TabEspGlo[Nom vernaculaire]].Value)
   Case CBM.CBx Is CBxAjouNomLatin: CBM.SujetBdD = SujetCBx([TabEspGlo[Nom latin]].Value)
   Case CBM.CBx Is CBxAjouCD_NOM: CBM.SujetBdD = SujetCBx([TabEspGlo[CD_NOM]].Value)
   End Select
End Sub

TabEspGlo est un tableau de la feuille "SOURCE"

Je me suis surement mal exprimé, désolé, mais mon idée de départ, était d'utiliser un tableau VBA fait avec :

With Sheets("SOURCE")
tabloBD = .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 4)
End With

Je pensais qu'avec un tableau VBA de ce type ça irait plus vite !
Bien sur j'ai essayé de modifier le code mais sans résultat.

 

[Dranreb]

Je n'ai quant à moi jamais eu espoir que ça irait plus vite.
J'ai seulement exposé une possibilité de l'objet ComboBoxLiées.
Oui, au lieu de [TabEspGlo[Classe]].Value on devrait pouvoir spécifier WorksheetFunction.Index(tabloBD, 0, 1).Value comme argument de SujetCBx

 

[pmfontaine]

Je n'ai quant à moi jamais eu espoir que ça irait plus vite.

Ok donc mes recherche d'amélioration resteront vaines.
Dommage, j'espérerais améliorer en temps cet userform qui met environs 25 s pour s'initialiser.
Heureusement il n'est pas utilisé fréquemment.
Merci à tous
Patrick

 

[Dranreb]

Il faudrait déjà diviser la base en une demi douzaine de très grandes catégories de moins de 100000 espèces chacune, mais le choix de celle ci serait à faire en premier, genre cascade, seul le reste serait lié par choix en ordre quelconque.