VBA_Liste a choix multiples
Fermé
Bonjour,
Je suis en train de travailler sur VBA, et dans un formulaire, j'ai cree une liste a choix multiple.
Le probleme, c'est que quand j'execute ma macro, elle ne me retient que la derniere valeur selectionne, alors que j'aurais besoin que toutes les valeurs selectionnees soient prises en compte.
Pourriez vous me donner un coup de main?
Merci,
anais
Je suis en train de travailler sur VBA, et dans un formulaire, j'ai cree une liste a choix multiple.
Le probleme, c'est que quand j'execute ma macro, elle ne me retient que la derniere valeur selectionne, alors que j'aurais besoin que toutes les valeurs selectionnees soient prises en compte.
Pourriez vous me donner un coup de main?
Merci,
anais
A voir également:
- VBA_Liste a choix multiples
- Liste déroulante de choix excel - Guide
- Liste déroulante choix multiple excel sans vba ✓ - Forum Excel
- Excel choix multiple conditionnel - Guide
- Téléchargez le fichier et modifiez-le avec le logiciel de montage vidéo de votre choix. supprimez les 3 moments avec le papillon : votre vidéo est donc fractionnée en 4 morceaux. dupliquez le premier morceau et placez la copie à la fin de la vidéo. déplacez le deuxième morceau à la fin de vidéo. recollez tous les morceaux pour ne pas laisser de blanc. à quelle seconde peut-on voir la bouteille encore entière ? - Forum Bureautique
- En raison des multiples violations des consignes communautaires - Forum Mail
2 réponses
bjr
voici des codes a adapter
Private Sub CmdOK_Click()
Unload UserForm1
Dim Tblo()
Dim A As Integer
Dim B As Integer
Dim T As Integer
With Me.ListBox1
'Déterminer le nombre d'items choisis
For A = 0 To .ListCount - 1
If .Selected(A) Then
T = T + 1
End If
Next A
'Si aucun élément sélectionné , fin de la procédure
If T = 0 Then Exit Sub
'Dimensionnement du tableau
'Avec preserve on ne peut redimensionner que
'la dernière dimension d'un tableau
'de façon dynamique -> raison du décompte(partie1)
ReDim Preserve Tblo(1 To T)
'valeur sélectionnée mise dans le tableau
For A = 0 To .ListCount - 1
If .Selected(A) Then
B = B + 1
Tblo(B) = .List(A, 0)
'le 0 indique que l'item est dans la première colonne de la liste
'dans cet exemple il n'y a qu'une colonne
End If
Next A
End With
'Copie le tableau à partir de B16 = cells(16,2)
Range(Cells(16, 2), Cells(16 + UBound(Tblo) - 1, 2)) = Application.Transpose(Tblo)
' Attention aux index qui commencent à 0 et non pas à 1... !
' NB subtilité des array... : un tableau à une dimension s'inscrit sur
'une ligne... il faut donc utiliser transpose pour obtenir le résultat
'en colonne.
'Libère la mémoire
Erase Tblo
End Sub
Private Sub UserForm_Initialize()
Range("B16:B26").ClearContents 'efface la plage résultats
ListBox1.RowSource = "liste1!liste"
ListBox1.ListIndex = -1
End Sub
voici des codes a adapter
Private Sub CmdOK_Click()
Unload UserForm1
Dim Tblo()
Dim A As Integer
Dim B As Integer
Dim T As Integer
With Me.ListBox1
'Déterminer le nombre d'items choisis
For A = 0 To .ListCount - 1
If .Selected(A) Then
T = T + 1
End If
Next A
'Si aucun élément sélectionné , fin de la procédure
If T = 0 Then Exit Sub
'Dimensionnement du tableau
'Avec preserve on ne peut redimensionner que
'la dernière dimension d'un tableau
'de façon dynamique -> raison du décompte(partie1)
ReDim Preserve Tblo(1 To T)
'valeur sélectionnée mise dans le tableau
For A = 0 To .ListCount - 1
If .Selected(A) Then
B = B + 1
Tblo(B) = .List(A, 0)
'le 0 indique que l'item est dans la première colonne de la liste
'dans cet exemple il n'y a qu'une colonne
End If
Next A
End With
'Copie le tableau à partir de B16 = cells(16,2)
Range(Cells(16, 2), Cells(16 + UBound(Tblo) - 1, 2)) = Application.Transpose(Tblo)
' Attention aux index qui commencent à 0 et non pas à 1... !
' NB subtilité des array... : un tableau à une dimension s'inscrit sur
'une ligne... il faut donc utiliser transpose pour obtenir le résultat
'en colonne.
'Libère la mémoire
Erase Tblo
End Sub
Private Sub UserForm_Initialize()
Range("B16:B26").ClearContents 'efface la plage résultats
ListBox1.RowSource = "liste1!liste"
ListBox1.ListIndex = -1
End Sub