listbox -> textbox multiligne -> cellules
Bonsoir
je suis sous vba excel 2016
j'ai affecté des articles dans une listebox quand on sélectionne certains de ces articles ils s'affichent dans une textbox multiligne.
en cliquant sur le bouton "OK" je voulais qu'ils s'affichent dans des cellules les unes au-dessous des autres
=> le problème c'est qu'ils s’affichent dans la même cellule.
voici mon code au complet
Merci pour votre aide
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
Option Explicit
Private Sub CommandButton1_Click()
Dim monTxt As String, i As Integer, s As Integer
monTxt = Me.TextBox1.Text ' recupere tous ce qui a été taper dans le textbox
For i = 15 To NbOc(Me.TextBox1.Text, Chr(10)) 'pour i = 1 a nombre de fois ou il y a eu "Entrée " de taper dans la textbox
Cells(i, 1) = Left(monTxt, InStr(monTxt, Chr(10)) - 1) ' recupere le texte debut le début jusqu'a la premiere occurence de la touche "entree"
monTxt = Right(monTxt, Len(monTxt) - InStr(monTxt, Chr(10))) ' redécoupe la chaine à partir de la premiere touche "Entree" jusqu'a la fin
If i = 29 Then Exit For ' si on arrive à l'avant derniere ligne alors on sort prématurement de la boucle et s'il y avait
' plus de 30 lignes alors toutes les lignes restantes seront dans la ligne 30.
Next i
Cells(i, 1) = monTxt ' inscrit la derniere ligne du textbox
Unload Me
End Sub
Function NbOc(Chaine As String, Ch As String, Optional RC As Integer = 1) As Long
' Function de Yocrita
NbOc = (Len(Chaine) - Len(Replace(Chaine, Ch, "", , , RC))) / Len(Ch)
End Function
Private Sub ListBox1_Change()
If ListBox1.ListIndex <> -1 Then
TextBox1 = ""
Dim i As Integer, sep As Variant
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
TextBox1 = TextBox1 & sep & ListBox1.List(i)
If sep = "" Then sep = Chr(10)
End If
Next i
End If
End Sub
Private Sub UserForm_Initialize()
Worksheets("Projet 1").Activate
ListBox1.Clear
Dim i As Integer
For i = 28 To 51
ListBox1.AddItem Cells(i, 4)
Next
End Sub |
