Bonjour à tous,
Voici quelques temps j'ai monté un fichier qui permet de récupérer des informations dans une userform en renseignant une textbox. Le but est de commencer à écrire un mot, et la macro cherche dans une feuille BD, les données qui s'y rapportent pour les faire apparaître dans la list box.
Tout allait bien, sauf que maintenant quand on renseigne la textbox une erreur 13 apparaît au niveau de la ligne en rouge. J'ai essayé de trouver l'erreur mais sans succès et j'ai aggravé le truc puisque maintenant j'ai une erreur au niveau de la ligne verte...
J'ai bien essayé de shunter l'erreur, mais même si cela fonctionne, le tri ne se fait plus.
Pourriez vous m'éclairer sur ce qui ne fonctionne pas/ plus dans ce code ? Je joins le fichier pour plus de clarté.
Je vous remercie pour votre aide précieuse.
Option Explicit
Dim f, choix(), Rng, Ncol
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Rng = f.Range("a2:L" & f.[a65000].End(xlUp).Row)
TblTmp = Rng.Value
Ncol = Rng.Columns.Count
For i = LBound(TblTmp) To UBound(TblTmp)
ReDim Preserve choix(1 To i)
For k = LBound(TblTmp) To UBound(TblTmp, 2)
choix(i) = choix(i) & TblTmp(i, k) & " * "
Next k
Next i
Me.ListBox1.List = Rng.Value
End Sub
Private Sub TextBox1_Change()
If Me.TextBox1 <> "" Then
mots = Split(Trim(Me.TextBox1), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "*")
n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Me.Label1.Caption = UBound(Tbl) + 1
If Me.Label1.Caption = "0" Then
Call MsgBox("Le fournisseur n'est pas existant. Souhaitez vous le créer? ", 4 + vbInformation, "Attention")
Voici quelques temps j'ai monté un fichier qui permet de récupérer des informations dans une userform en renseignant une textbox. Le but est de commencer à écrire un mot, et la macro cherche dans une feuille BD, les données qui s'y rapportent pour les faire apparaître dans la list box.
Tout allait bien, sauf que maintenant quand on renseigne la textbox une erreur 13 apparaît au niveau de la ligne en rouge. J'ai essayé de trouver l'erreur mais sans succès et j'ai aggravé le truc puisque maintenant j'ai une erreur au niveau de la ligne verte...
J'ai bien essayé de shunter l'erreur, mais même si cela fonctionne, le tri ne se fait plus.
Pourriez vous m'éclairer sur ce qui ne fonctionne pas/ plus dans ce code ? Je joins le fichier pour plus de clarté.
Je vous remercie pour votre aide précieuse.
Option Explicit
Dim f, choix(), Rng, Ncol
Private Sub Label1_Click()
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Set Rng = f.Range("a2:L" & f.[a65000].End(xlUp).Row)
TblTmp = Rng.Value
Ncol = Rng.Columns.Count
For i = LBound(TblTmp) To UBound(TblTmp)
ReDim Preserve choix(1 To i)
For k = LBound(TblTmp) To UBound(TblTmp, 2)
choix(i) = choix(i) & TblTmp(i, k) & " * "
Next k
Next i
Me.ListBox1.List = Rng.Value
End Sub
Private Sub TextBox1_Change()
If Me.TextBox1 <> "" Then
mots = Split(Trim(Me.TextBox1), " ")
Tbl = choix
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
n = 0: Dim b()
For i = LBound(Tbl) To UBound(Tbl)
a = Split(Tbl(i), "*")
n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
For k = 1 To Ncol
b(k, i + 1) = a(k - 1)
Next k
Next i
If n > 0 Then
ReDim Preserve b(1 To Ncol, 1 To n + 1)
Me.ListBox1.List = Application.Transpose(b)
Me.ListBox1.RemoveItem n
End If
Me.Label1.Caption = UBound(Tbl) + 1
If Me.Label1.Caption = "0" Then
Call MsgBox("Le fournisseur n'est pas existant. Souhaitez vous le créer? ", 4 + vbInformation, "Attention")
