IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

ListBox avec Retour à la Ligne [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Membre confirmé
    Homme Profil pro
    Responsable de compte
    Inscrit en
    Février 2017
    Messages
    59
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Nouvelle-Calédonie

    Informations professionnelles :
    Activité : Responsable de compte
    Secteur : Finance

    Informations forums :
    Inscription : Février 2017
    Messages : 59
    Par défaut ListBox avec Retour à la Ligne
    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

  2. #2
    Membre confirmé Avatar de ippo_master
    Homme Profil pro
    Ingénieur qualité méthodes
    Inscrit en
    Septembre 2007
    Messages
    71
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Haute Garonne (Midi Pyrénées)

    Informations professionnelles :
    Activité : Ingénieur qualité méthodes

    Informations forums :
    Inscription : Septembre 2007
    Messages : 71
    Par défaut
    Bonjour,

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

  3. #3
    Membre confirmé
    Homme Profil pro
    Responsable de compte
    Inscrit en
    Février 2017
    Messages
    59
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Nouvelle-Calédonie

    Informations professionnelles :
    Activité : Responsable de compte
    Secteur : Finance

    Informations forums :
    Inscription : Février 2017
    Messages : 59
    Par défaut
    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.

    Nom : Annotation 2020-02-21 054351.png
Affichages : 1217
Taille : 14,3 Ko

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 8
    Dernier message: 04/07/2007, 14h33
  2. [utilitaire bcp]problème avec retour à la ligne
    Par m-mas dans le forum MS SQL Server
    Réponses: 1
    Dernier message: 24/05/2007, 15h10
  3. [CSS] espace dans les li avec retour à la ligne
    Par grinder59 dans le forum Mise en page CSS
    Réponses: 4
    Dernier message: 04/07/2006, 11h00
  4. Bouton avec retour a ligne
    Par Dsphinx dans le forum AWT/Swing
    Réponses: 11
    Dernier message: 29/05/2006, 21h30
  5. Concatérner chaine avec retour à la ligne
    Par nebule dans le forum Général JavaScript
    Réponses: 6
    Dernier message: 30/11/2004, 11h55

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo