Erreur d'exécution '381': impossible de définir la propriété list...

Résolu/Fermé
Pacho01 Messages postés 3 Date d'inscription mercredi 15 décembre 2010 Statut Membre Dernière intervention 20 avril 2019 - 19 avril 2019 à 18:54
Pacho01 Messages postés 3 Date d'inscription mercredi 15 décembre 2010 Statut Membre Dernière intervention 20 avril 2019 - 20 avril 2019 à 06:07
Bonjour cher communauté,

Voilà deux jours que je galère sur erreur que je trouve un peu bizzare, parce qu'elle ne devrait pas être là, à mon avis.
En fait, je chercher à lier des fiches Excel à des listBox et vice versa.
Voici les codes

'Code pour lancer la recherche et initialiser l'entête de la bar de recherche


Private Sub btnSearch_Click()

Dim searchCust As String, searchPerson As String
Dim searchCode As Integer: searchCode = 0
Dim i As Integer: i = 6

Set ws = ThisWorkbook.Worksheets("mySheet2")

Header1 = ws.Range("A" & i).Value
Header2 = ws.Range("K" & i).Value
Header3 = ws.Range("E" & i).Value
Header4 = ws.Range("D" & i).Value
Header5 = ws.Range("B" & i).Value

If Me.ListBox_header.ListCount = 0 Then
Call CreateListBoxHeader(Me.lbSearch, Me.ListBox_header, _
Array(Header1, Header2, Header3, Header4, Header5))
End If


If Me.tbLineNum.Text <> "" Then
searchCode = Me.tbLineNum.Text
End If
If Me.CbSearchCust.Text <> "" Then
searchCust = Me.CbSearchCust.Text
End If
If Me.cbSearchCyPerson.Text <> "" Then
searchPerson = Me.cbSearchCyPerson.Text
End If

fillListBox searchCode, searchCust, searchPerson

End Sub




'Code pour formate r(rendre jolie) l'entête de la listBox


Public Sub CreateListBoxHeader(body As MSForms.ListBox, header As MSForms.ListBox, arrHeaders)
' make column count match
header.ColumnCount = body.ColumnCount
header.ColumnWidths = body.ColumnWidths

' add header elements
header.Clear
header.AddItem
Dim i As Integer
For i = 0 To UBound(arrHeaders)
header.List(0, i) = arrHeaders(i)
Next i

' make it pretty
body.ZOrder (1)
header.ZOrder (0)
header.SpecialEffect = fmSpecialEffectFlat
header.BackColor = RGB(200, 200, 200)
header.Height = 15

' align header to body (should be done last!)
header.Width = body.Width
header.Left = body.Left
header.Top = body.Top - (header.Height - 1)
End Sub



'Code pour remplir la listBox à partir de données de la feuille "mySheet2)


Private Sub fillListBox(searchCode As Integer, Optional searchCust As String, Optional searchPerson As String)
Dim i As Integer: i = 7
Dim j As Integer: j = 0

Set myForm = Me

Set ws = ThisWorkbook.Worksheets("mySheet2")

lbSearch.Clear

If searchCode > 0 And searchCust <> "" And searchPerson <> "" Then
While ws.Range("B" & i) <> ""
If ws.Range("A" & i) = searchCode Then
Me.lbSearch.AddItem
Me.lbSearch.List(j, 0) = ws.Range("A" & i).Value
Me.lbSearch.List(j, 1) = ws.Range("K" & i).Value
Me.lbSearch.List(j, 2) = ws.Range("E" & i).Value
Me.lbSearch.List(j, 3) = ws.Range("D" & i).Value
Me.lbSearch.List(j, 4) = ws.Range("B" & i).Value
End If
j = j + 1
i = i + 1
Wend
ElseIf searchCode > 0 Then
While ws.Range("B" & i) <> ""
If ws.Range("A" & i) = searchCode Then
Me.lbSearch.AddItem
Me.lbSearch.List(j, 0) = ws.Range("A" & i).Value
Me.lbSearch.List(j, 1) = ws.Range("K" & i).Value
Me.lbSearch.List(j, 2) = ws.Range("E" & i).Value
Me.lbSearch.List(j, 3) = ws.Range("D" & i).Value
Me.lbSearch.List(j, 4) = ws.Range("B" & i).Value
End If
j = j + 1
i = i + 1
Wend
ElseIf searchCust <> "" Then
While ws.Range("B" & i) <> ""
If InStrB(1, ws.Range("B" & i).Value, searchCust, vbBinaryCompare) <> 0 Then
Me.lbSearch.AddItem
Me.lbSearch.List(j, 0) = ws.Range("A" & i).Value
Me.lbSearch.List(j, 1) = ws.Range("K" & i).Value
Me.lbSearch.List(j, 2) = ws.Range("E" & i).Value
Me.lbSearch.List(j, 3) = ws.Range("D" & i).Value
Me.lbSearch.List(j, 4) = ws.Range("B" & i).Value
End If
j = j + 1
i = i + 1
Wend
ElseIf searchPerson <> "" Then
While ws.Range("B" & i) <> ""
If InStr(1, ws.Range("B" & i).Value, searchPerson, vbTextCompare) <> 0 Then
Me.lbSearch.AddItem
Me.lbSearch.List(j, 0) = ws.Range("A" & i).Value
Me.lbSearch.List(j, 1) = ws.Range("K" & i).Value
Me.lbSearch.List(j, 2) = ws.Range("E" & i).Value
Me.lbSearch.List(j, 3) = ws.Range("D" & i).Value
Me.lbSearch.List(j, 4) = ws.Range("B" & i).Value
End If
j = j + 1
i = i + 1
Wend

End If
End Sub



Voici l'exemple de la fenêtre


Apparemment, tout marche bien et deux premières lignes s'affichent. Après, c'est l'erreur et plus rien d'autre. J'ai peut-être besoin d'oeil extérieur pour m'aider à avancer.

La listBox ne se remplie pas de tous les éléments de la recherche et affiche l'erreur suivant:


J'ai vraiment besoin de votre précieuse aide, svp !

1 réponse

jordane45 Messages postés 38167 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 7 mai 2024 4 658
19 avril 2019 à 23:17
Bonjour,

Déjà, pour effectuer des recherches dans excel il y a plus rapide et plus "propre" que des boucles sur toutes les lignes de ton tableau... la méthode FIND (voir findall )
https://forums.commentcamarche.net/forum/affich-37621992-methode-find-dans-vba-recherche-de-donnees-sous-excel#findall

Ensuite, il semble que le message indique que l'index n'est pas bon...
A quelle ligne de code se produit l'erreur ? As tu essayé de mettre un point d'arrêt puis d'éxecuter ton code en mode pas à pas pour essayer de déterminer l'endroit et voir le contenu de tes variables ?

1
Pacho01 Messages postés 3 Date d'inscription mercredi 15 décembre 2010 Statut Membre Dernière intervention 20 avril 2019
20 avril 2019 à 06:07
Merciiiiiiiiiiii !!!!

Effectivement, il fallait que je mette un point d'arrêt d'exécution pour voir le contenu de mes variables.
J'ai défini 5 colonnes et le conteur des colonnes (j, ici) s'incrémentait à chaque fois, même quand la condition est fausse. Il fallait juste le mettre dans la condition.



While ws.Range("B" & i) <> ""
If InStrB(1, ws.Range("B" & i).Value, searchCust, vbBinaryCompare) <> 0 Then
Me.lbSearch.AddItem
Me.lbSearch.List(j, 0) = ws.Range("A" & i).Value
Me.lbSearch.List(j, 1) = ws.Range("K" & i).Value
Me.lbSearch.List(j, 2) = ws.Range("E" & i).Value
Me.lbSearch.List(j, 3) = ws.Range("D" & i).Value
Me.lbSearch.List(j, 4) = ws.Range("B" & i).Value
j = j + 1
End If
i = i + 1
Wend



Et comme tu me l'as dit, je vais voir du côté de la méthode FIND pour rendre mon code "propre" et peut-être l'améliorer. Je suis open à toute proposition !

Merci pour ton aide si précieuse ! Excellent week-end de pâque ! Et que DIEU te bénisse !
0