XL 2016 Remplir Combobox vitesse grand v [RESOLU]

[Compte Supprimé 979]

Bonjour à toutes et à tous 😉

Qui saura répondre à ma problématique...
J'ai un fichier ".xlsx" contenant les 36.000 communes françaises et leur code postal
J'aimerai à partir d'un autre fichier contenant un USF, venir alimenter les 2 colonnes de la combobox

Je pensais le faire via la méthode ADO, mais avec mon code, le remplissage est "long"

Private Sub UserForm_Activate()
  Dim sPathBdD As String, sTable As String, FlgErrCon As Boolean
  Dim sSQL As String, sField As String, IdField As Integer
  ' Initialiser les variables
  sTable = "Liste"
  sPathBdD = VParam("DossierBdD")
  If Right(sPathBdD, 1) <> "\" Then sPathBdD = sPathBdD & "\"
  sPathBdD = sPathBdD & "BdD Villes.xlsx"
  ' Tester si le fichier se trouve bien à l'endroit prévu
  If Not ExisteFichier(sPathBdD) Then
    sPathBdD = Application.GetOpenFilename(FileFilter:="BdD Villes (*.xls*), *.xls*", _
        Title:="Merci de sélectionner le fichier des viles")
  End If

  ' En cas d'erreur
  On Error GoTo Erreur_Proc
  ' Vider la combobox en question et initialiser la chaine de connexion
  If Me.Cbx_Choix.ListCount > 0 Then Me.Cbx_Choix.Clear
  FlgErrCon = False: sConn = ""
  ' Créer une nouvelle instance ADO
  Set Cnn = CreateObject("ADODB.Connection")
  ' Créer la connexion vers le fichier Excel
  With Cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
           & sPathBdD & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
  End With
  ' En cas d'erreur message d'information à l'utilisateur
  If FlgErrCon = True Then
    MsgBox "Impossible de se connecter à la base de données !", vbCritical, "OUPS..."
    GoTo FermetureCnn
  End If
  ' Préparer la requête
  If InStr(1, sTable, " ") > 0 Then
    sSQL = "SELECT * FROM ['" & sTable & "$']"
  Else
    sSQL = "SELECT * FROM [" & sTable & "$]"
  End If
  ' Créer un nouveau Recordset et l'ouvrir
  Set Rs = CreateObject("ADODB.Recordset")
  ' Avec le Recordset, récupérer les enregistrements
  With Rs
    ' Ouvrir le recordset
    .Open sSQL, Cnn, CursorType
    ' En cas d'erreur
    If FlgErrCon = True Then GoTo FermetureRs
    ' Sinon
    Do While Not .EOF
      Me.Cbx_Choix.AddItem Rs.Fields(0)
      Me.Cbx_Choix.List(Me.Cbx_Choix.ListCount - 1, 1) = Rs.Fields(1)
      ' Enregistrement suivant
      .MoveNext
    Loop
  End With
  ' Fermeture du Recordset
FermetureRs:
  Rs.Close
  Set Rs = Nothing

  ' Fermeture de la connexion
FermetureCnn:
  Cnn.Close: Set Cnn = Nothing
  On Error GoTo 0
  Me.Caption = "CHOIX de la VILLE du CHANTIER"
  Exit Sub

Erreur_Proc:
  FlgErrCon = True  ' Mettre le FLAG d'erreur de connexion à vrai
  Resume Next
End Sub

Qui saurait me raccourcir le temps d'exécution 😛
Chose importante, je ne veux pas intégrer la liste des villes dans mon fichier principal.

A+

 

[Compte Supprimé 979]

Merci à tous pour vos idées et votre participation

Voici le résultat final (simple et succinct) qui pour ma part me convient parfaitement 😉

Au plaisir