XL 2013 [Résolu] ListBox avec sauts de lignes multi-colonnes

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Lone-wolf

XLDnaute Barbatruc
Bonjour à toutes et à tous 🙂

Je cherche à afficher dans une listbox les sauts de lignes d'une feuille. J'ai touvé cette macro fait par job75 à cette adresse ListBox-Sauts de lignes

La macro prend en charge qu'une colonne et j'ai essaié de l'adapter pour 4 colonnes, mais sans succès.

Job, si tu pourrait intervenir ça serait sympa. Le formulaire en question est UsfListeRetenues et la feuille "Retenues et exclusions".
 

Pièces jointes

Bonjour,

Essai ListBox avec saut de ligne multi-colonnes.
-Pour découper les commentaires, on recherche VbCrLf (Chr(13) & Chr(10) -import-.
-Si les commentaires ont étés saisis avec Alt+Entrée, il faut chercher Chr(10)

http://boisgontierjacques.free.fr/fichiers/Formulaire/ListBoxSautLigne.xlsm

Code:
Dim Rng, TblBD()
Private Sub UserForm_Initialize()
     Set f = Sheets("BD")
     Set Rng = f.Range("A2:F" & f.[A65000].End(xlUp).Row)
     TblBD = Rng.Value
     Me.ListBox1.ColumnCount = Rng.Columns.Count
     'Me.ListBox1.ColumnWidths = "50;50;150;150;150"
     '--- alim combobox
     Set d = CreateObject("Scripting.Dictionary")
     d("*") = ""
     For i = LBound(TblBD) To UBound(TblBD)
        d(TblBD(i, 2)) = ""
     Next i
     Me.ComboBox1.List = d.keys
     Me.ComboBox1 = "*"
     EnTeteListBox
     Filtre
End Sub

Private Sub ComboBox1_click()
  Filtre
End Sub

Sub Filtre()
     Dim TblBD2()
     NbColCmt = 4      ' adapter
     ligne = 0
     Dim a(): ReDim a(1 To NbColCmt)
     clé = Me.ComboBox1: colClé = 2
     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), vbCrLf)
            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), vbCrLf, ""): Next k
            ligne = ligne + 1
          Next j
        End If
     Next i
     Me.ListBox1.Column = TblBD2
End Sub


Boisgontier
 

Pièces jointes

Dernière édition:
Bonjour,

-Avec la modif, on ne doit plus voir les crochets.

For k = 1 To NbColCmt: TblBD2(k + 2, ligne) = Replace(TblM(j + 1, k), Chr(13), ""): Next k

http://boisgontierjacques.free.fr/fichiers/Formulaire/ListBoxSautLigne.xlsm

-Si les sauts de lignes dans les commentaires ont étés obtenus avec Alt+Entrée(chr(10) au lieu de Chr(13) & Chr(10), il faut également modifier:

a(k) = Split(TblBD(i, k + 2), vbCrLf) ' ou Chr(10) ai lieu de vbCrLf


-Un autre exemple de saut de ligne dans ListBox pour séparer des groupes:

http://boisgontierjacques.free.fr/fichiers/Formulaire/ListBoxSautLigneGroupe.xlsm


Boisgontier
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour