Erreur 9 'Subscript out of range
Bonjour,
Je tente de faire une recherche dans une ListBox avec une TextBox mais je ne comprends pas, j'ai une erreur qui apparaît. Pouvez vous m'aider, car je ne comprends pas d'où ceci peut venir.
Voici le code :
Option Explicit
Option Compare Text
Dim Ws1 As Worksheet
Dim derligne As Long
Dim Ligne As Long
Private Sub Userform_Initialize()
Application.ScreenUpdating = False
Dim say As Integer
say = WorksheetFunction.CountA(Worksheets("Stock").Range("A:A"))
ListBox1.RowSource = "Stock!A2:I" & say
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60"
ListBox1.MultiSelect = fmMultiSelectMulti
Application.ScreenUpdating = True
Set Ws1 = Sheets("Stock")
derligne = Ws1.Range("A" & Rows.Count).End(xlUp).Row
ListBox1.ColumnCount = 8
ListBox1.ColumnWidths = "60;60;60;60;60;60;60;60"
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1.RowSource = "Stock!A2:H" & Ws1.Range("A65536").End(xlUp).Row 'toute la plage de la ListBox1
ListBox2.RowSource = "Stock!A2:H" & Ws1.Range("A65536").End(xlUp).Row 'toute la plage de la ListBox2
ListBox3.RowSource = "Stock!A2:H" & Ws1.Range("A65536").End(xlUp).Row 'toute la plage de la ListBox1
End Sub
Private Sub CommandButton2_Click() 'bouton OK
Application.ScreenUpdating = False
Dim isim As Range
Dim dercel As Range
Dim liste As Long
Sheets("Stock").Activate
Set dercel = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
liste = ListBox1.ListCount
If TextBox1 = Empty Then
MsgBox ("Entrer un code produit")
TextBox1.SetFocus
Exit Sub
End If
ListBox1.RowSource = Empty
ListBox1.Clear
ListBox1.ColumnCount = 8
For Each isim In dercel
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
ListBox1.AddItem
ListBox1.List(liste, 0) = isim
ListBox1.List(liste, 1) = isim.Offset(0, 1)
ListBox1.List(liste, 2) = isim.Offset(0, 2)
ListBox1.List(liste, 3) = Format(isim.Offset(0, 3), "dd.mm.yyyy")
ListBox1.List(liste, 4) = isim.Offset(0, 4)
ListBox1.List(liste, 5) = isim.Offset(0, 5)
ListBox1.List(liste, 6) = isim.Offset(0, 6)
ListBox1.List(liste, 7) = isim.Offset(0, 7)
ListBox1.List(liste, 8 ) = isim.Offset(0, 8 )
End If
Next
Application.ScreenUpdating = True
End Sub
Merci d'avance
U_goffu a écrit :Bonjour,
Je tente de faire une recherche dans une ListBox avec une TextBox mais je ne comprends pas, j'ai une erreur qui apparaît. Pouvez vous m'aider, car je ne comprends pas d'où ceci peut venir.
Bonjour,
Quelle erreur ? Il vaut mieux joindre ton fichier.
Bonjour,
C'était l'erreur qui est en titre du post à savoir erreur 9'Subscript out of range', mais c'est bon, j'ai trouvé mon erreur. Ils'agissait d'une mauvaise définition de mes colonnes dans ma Listbox. En tout cas méci quand même, j'ai pas pu te répondre dans l'immédiat.
Cordialement
Bon bah finalement, j'ai changé le code, car sa ne m'allait pas et du coup, j'ai toujours la même erreur. Je voudrais faire une recherche intuitif dans une ListBox et j'ai récupéré un code sur internet que j'ai voulu modifier, mais je n'arrive pas à l'appliquer pour mon cas. Pouvez vous m'aider?
Voici mon fichier:
Désolé mon fichier est trop grand. Voici le lien pour le trouver :
Bonjour,
Finalement j'ai trouvé le code qui fonctionne pour moi :
'Recherche par code produit (se trouve dans la première colonne (A)
Private Sub CommandButton2_Click() 'bouton OK page1
Application.ScreenUpdating = False
Sheets("Stock").Activate
If TextBox1 = Empty Then
MsgBox "Entrer une valeur à chercher"
TextBox1.SetFocus
Exit Sub
End If
ListBox1.RowSource = Empty
ListBox1.Clear
ListBox1.ColumnCount = 9
For Each isim In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox1)) & "*" Then
liste = ListBox1.ListCount
ListBox1.AddItem
ListBox1.List(liste, 0) = isim
ListBox1.List(liste, 1) = isim.Offset(0, 1)
ListBox1.List(liste, 2) = isim.Offset(0, 2)
ListBox1.List(liste, 3) = isim.Offset(0, 3)
ListBox1.List(liste, 4) = isim.Offset(0, 4)
ListBox1.List(liste, 5) = isim.Offset(0, 5)
ListBox1.List(liste, 6) = isim.Offset(0, 6)
ListBox1.List(liste, 7) = isim.Offset(0, 7)
ListBox1.List(liste, 8) = isim.Offset(0, 8)
End If
Next
Application.ScreenUpdating = True
End Sub
'Recherche par description (se trouve dans la deuxième colonne (B)
Private Sub CommandButton3_Click() 'bouton OK page2
Application.ScreenUpdating = False
Sheets("Stock").Activate
If TextBox2 = Empty Then
MsgBox "Entrer une valeur à chercher"
TextBox2.SetFocus
Exit Sub
End If
ListBox2.RowSource = Empty
ListBox2.Clear
ListBox2.ColumnCount = 9
For Each isim In Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox2)) & "*" Then
liste = ListBox2.ListCount
ListBox2.AddItem
ListBox2.List(liste, 0) = isim.Offset(0, -1) 'code produit
ListBox2.List(liste, 1) = isim
ListBox2.List(liste, 2) = isim.Offset(0, 1)
ListBox2.List(liste, 3) = isim.Offset(0, 2)
ListBox2.List(liste, 4) = isim.Offset(0, 3)
ListBox2.List(liste, 5) = isim.Offset(0, 4)
ListBox2.List(liste, 6) = isim.Offset(0, 5)
ListBox2.List(liste, 7) = isim.Offset(0, 6)
ListBox2.List(liste, 8) = isim.Offset(0, 7)
ListBox2.List(liste, 9) = isim.Offset(0, 8)
End If
Next
Application.ScreenUpdating = True
End Sub
'Recherche par rangement (se trouve dans la 9ème colonne (I)
Private Sub CommandButton4_Click() 'bouton OK page3
Application.ScreenUpdating = False
Sheets("Stock").Activate
If TextBox3 = Empty Then
MsgBox "Entrer une valeur à chercher"
TextBox3.SetFocus
Exit Sub
End If
ListBox3.RowSource = Empty
ListBox3.Clear
ListBox3.ColumnCount = 9
For Each isim In Range("I2:I" & Range("A" & Rows.Count).End(xlUp).Row)
If UCase(LCase(isim)) Like UCase(LCase(TextBox3)) & "*" Then
liste = ListBox3.ListCount
ListBox3.AddItem
'ListBox3.List(liste,
ListBox3.List(liste, 0) = isim.Offset(0, -8)
ListBox3.List(liste, 1) = isim.Offset(0, -7)
ListBox3.List(liste, 2) = isim.Offset(0, -6)
ListBox3.List(liste, 3) = isim.Offset(0, -5)
ListBox3.List(liste, 4) = isim.Offset(0, -4)
ListBox3.List(liste, 5) = isim.Offset(0, -5)
ListBox3.List(liste, 6) = isim.Offset(0, -6)
ListBox3.List(liste, 7) = isim.Offset(0, -7)
ListBox3.List(liste, 8) = isim
End If
Next
Application.ScreenUpdating = True