Discussion :

[ncl98]

Bonjour,
Voilà plusieurs jours que je galère pour insérer des retours à la ligne dans un ListBox, Mais à force de persévérance, j'ai trouvé une solution grâce à un code de J. BOISGONTIER et à SILKYROAD (https://silkyroad.developpez.com/VBA...nesCaracteres/) que je remercie grandement. Je souhaite partager ce code car au vu de mes nombreuses recherches (internet et autres) restées vaines, j'espère qu'elle pourra aider certains d'entre vous.

Pour faire fonctionner le code, il faut :
- une feuille Excel nommée "Commentaires" avec 4 colonnes (ex. : Date/N° Dossier/Commentaires/Commentaires à retraiter
- un UserForm avec un ComboBox, un TextBox et un ListBox

Userform :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
 
'************************************
'Déclaration des variables publiques
'************************************
Dim Rng, TblBD()
Dim f As Worksheet
Dim d As Variant
 
Private Sub UserForm_Initialize()
Dim d As Variant
Dim i As Integer
 
'****************
'Base de données
'****************
Set f = Sheets("Commentaires")
Set Rng = f.Range("A2:C" & f.[A65000].End(xlUp).Row)
TblBD = Rng.Value
Me.ListBox1.ColumnCount = Rng.Columns.Count
 
'**************************
'Alimentation du ComboBox1
'**************************
Set d = CreateObject("Scripting.Dictionary")
d("*") = ""
For i = LBound(TblBD) To UBound(TblBD)
 d(TblBD(i, 1)) = ""
Next i
Me.ComboBox1.List = d.keys
Me.ComboBox1 = "*"
 
EnTeteListBox         'Entêtes du ListBox1
AfficherCommentaires  'Affichage des commentaires avec retour à la ligne (Module2)
 
End Sub
 
'******************************
'Choix du dossier via ComboBox1
'******************************
Private Sub ComboBox1_click()
  AfficherCommentaires 'Affichage des commentaires avec retour à la ligne (Module2)
End Sub
 
'**********************************
'Validation du nouveau commentaire
'**********************************
Private Sub CommandButton1_Click()
Dim n As Integer
Dim f As Worksheet
 
If Me.TextBox1 = "" Then
 MsgBox "Vous n'avez pas saisi de commentaires !"
 Exit Sub
End If
 
Set f = Sheets("Commentaires")
n = f.Range("A" & Rows.Count).End(xlUp).Row + 1
f.Range("D" & n) = Me.TextBox1
Commentaire           'Retour à la ligne du nouveau commentaire (Module1)
AfficherCommentaires  'Affichage des commentaires avec retour à la ligne (Module2)
End Sub
 
Sub EnTeteListBox()
Dim X As Integer
Dim Y As Integer
Dim c As Integer
Dim Lab As Control
Dim tempcol As Variant
 
   X = Me.ListBox1.Left + 8
   Y = Me.ListBox1.Top - 20
   For c = 1 To Rng.Columns.Count
       Set Lab = Me.Controls.Add("Forms.Label.1")
       Lab.Caption = Rng.Offset(-1).Item(1, c)
       Lab.Top = Y
       Lab.Left = X
       Lab.Height = 24
       Lab.Width = Rng.Columns(c).Width * 1#
       X = X + Rng.Columns(c).Width * 1
       tempcol = tempcol & Rng.Columns(c).Width * 1# & ";"
   Next c
   On Error Resume Next
   Me.ListBox1.ColumnWidths = tempcol
   On Error GoTo 0
End Sub

Module1:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Sub Commentaire()
Dim f As Worksheet
Dim Requête As String
Dim cible As String
Dim chaine As String
Dim n As Integer
Dim i As Integer
Dim X As Integer
 
Set f = Sheets("Commentaires")
n = f.Range("A" & Rows.Count).End(xlUp).Row + 1
 
Requête = f.Range("D" & n)                        'Récupération du commentaire où insérer les retours à la ligne
cible = Requête                                   'Copie du commentaire à retraiter dans la variable "cible" qui sera ensuite alimentée par paquets de 50 caractères
Requête = ""                                      'Vidage de la variable Requête qui sera réalimentée par le commentaire avec les retours à la ligne
 
 For i = 1 To Len(cible)                          'Boucle du 1er au dernier caractére du commentaire
  'Recherche du 50ème caractère, si plus de caractère à traiter, finalisation du commentaire retraité
   X = InStr(50, cible, "")
    If X = 0 Then
      chaine = cible
      Requête = Requête & chaine                   'Finaliation du commentaire avec les retours à la ligne
      Exit For
    End If
 
  chaine = Mid(cible, 1, X)                        'Extraction des paquets de 50 caractères de la variable "cible"
  Requête = Requête & chaine & vbCrLf              'Réécriture du commentaire ligne par ligne
  cible = Mid(cible, Len(chaine) + 1)              'Réalimentation de la variable "cible" avec des 50 caractères suivants
 Next
 
 
f.Range("A" & n) = Date
f.Range("B" & n) = "145000" & "-" & n - 1
f.Range("C" & n) = Requête
UserForm1.TextBox1.Text = ""
 
End Sub

Module2 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
'****************************************************************
'Affichage des commentaires dans un ListBox avec sauts de lignes
'****************************************************************
Sub AfficherCommentaires()
Dim TblBD2() As Variant
Dim TblBD As Variant
Dim Rng As Variant
Dim nbColCmt As Integer
Dim f As Worksheet
Dim ligne As Integer
Dim clé As String
Dim colClé As Integer
Dim i As Integer
Dim k As Integer
Dim lig As Integer
Dim mx As Integer
Dim j As Integer
 
     Set f = Sheets("Commentaires")
     Set Rng = f.Range("A2:C" & f.[A65000].End(xlUp).Row)
     TblBD = Rng.Value
     UserForm1.ListBox1.ColumnCount = Rng.Columns.Count
     nbColCmt = 1
     ligne = 0
     Dim a(): ReDim a(1 To nbColCmt)
     clé = UserForm1.ComboBox1: colClé = 1
     For i = 1 To UBound(TblBD)
        If TblBD(i, colClé) Like clé Then
          ligne = ligne + 1
          ReDim Preserve TblBD2(1 To UBound(TblBD, 2), 1 To ligne)
          TblBD2(1, ligne) = TblBD(i, 1): TblBD2(2, ligne) = TblBD(i, 2)
          ReDim TblM(1 To 20, 1 To nbColCmt)
          For k = 1 To nbColCmt
            a(k) = Split(TblBD(i, k + 2), vbLf)
            For lig = 0 To UBound(a(k)): TblM(lig + 1, k) = a(k)(lig): Next lig
            If UBound(a(k)) > mx Then mx = UBound(a(k))
          Next k
          For j = 0 To mx
            ReDim Preserve TblBD2(1 To UBound(TblBD, 2), 1 To ligne)
            For k = 1 To nbColCmt: TblBD2(k + 2, ligne) = Replace(TblM(j + 1, k), Chr(13), ""): Next k
            ligne = ligne + 1
          Next j
        End If
     Next i
     UserForm1.ListBox1.Column = TblBD2
End Sub

[ippo_master]

Bonjour,

Pourrais-tu illustrer ton besoin et sa résolution via une copie écran ?

[ncl98]

Bonjour,
Dans un outil de suivi de dossiers, chaque intervention doit faire l'objet d'un commentaire. Ces commentaires sont ensuite archivés pour constituer un historique. Or, la zone dédiée (ListBox) est trop étroite d'où la nécessité de reporter chaque commetnaire sur plusieurs lignes dans le listbox.