Erreur d'exécution '381': impossible de définir la propriété list... [Résolu/Fermé]

Signaler
Messages postés
3
Date d'inscription
mercredi 15 décembre 2010
Statut
Membre
Dernière intervention
20 avril 2019
-
Messages postés
3
Date d'inscription
mercredi 15 décembre 2010
Statut
Membre
Dernière intervention
20 avril 2019
-
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

Messages postés
28883
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
5 juillet 2020
2 596
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://www.commentcamarche.net/faq/36886-fonction-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
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 63737 internautes nous ont dit merci ce mois-ci

Messages postés
3
Date d'inscription
mercredi 15 décembre 2010
Statut
Membre
Dernière intervention
20 avril 2019

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 !