Comment afficher un retour à la ligne dans une textbox ?

Bonjour,

Je cherche à modifier le fichier example (ci-joint) de Boisgontier car pour mes besoins, je vais avoir des cellules qui vont contenir des retours à la ligne ( ALT + ENTREE )

Lors d'une recherche, la cellule contenant des retours à la ligne ne s'affiche pas correctement dans la textbox correspondante malgré le fait que j'ai essayé de remplacer les caractères de retours à la ligne dans le code VBA :

        Text6 = f.Cells(ligneEnreg, 6 + 1)
        Text6 = Replace(Text6, Chr(10), Chr(13) & Chr(10))

        Me.Controls("TextBox" & 6) = Text6
        MsgBox Text6

Le résultat obtenu est actuellement le suivant :

Comment faire pour que la textbox "Ville" n'affiche pas le contenu de la cellule avec chaque ligne à la suite avec le caractère :

Dans cet exemple, je voudrai que la textbox "Ville" affiche ceci :

Renne

Ligne

Ligne

Pouvez vous m'aider s'il vous plait ?

Cordialement,

Bonjour,

Allez dans votre USF et sélectionnez la textbox6 (ville)
Dans les propriétés de la textbox6, mettez la propriété MULTILINE à True (par déafut elle est à False)

Si ok -->

Cordialement

Merci beaucoup, ça fonctionne.

Sauriez vous me dire pourquoi le numéro de la ligne dans l'onglet BD n'est plus reporté dans la textbox en Jaune dès lors que des multilignes existent dans une cellule ?

Y a t-il un moyen pour que le numéro de ligne correspondant à la recherche refonctionne de nouveau, j'ai besoin de cette fonctionnalité .

Cordialement,

Sauriez vous me dire pourquoi le numéro de la ligne dans l'onglet BD n'est plus reporté dans la textbox en Jaune dès lors que des multilignes existent dans une cellule

On peut adapter le code mais si je ne me trompe vous voulez faire une base de données. Si oui ce n'est pas une bonne idée de faire une ligne avec une cellule comportant des retours à la ligne.
Vu que vous avez 3 villes concernées en ligne 2, vous devriez plutot faire 3 lignes. En gros une donnée par cellule
Après lors de la sélection des 2 combo, il vous faut une listbox au lieu d'une textbox.

En premier je modifierais ce point

Votre avis ?

Y a t-il un moyen pour que le numéro de ligne correspondant à la recherche refonctionne de nouveau, j'ai besoin de cette fonctionnalité ?

Pouvez-vous expliquer le pourquoi de ce besoin ?

En fait, je voudrai adapter l'exemple de Boisgontier à mon besoin.

La colonne nommée "Ville" sera a terme intitulée "Description" et dans les cellules de cette colonne se trouveront un paragraphe informatif de plusieurs lignes.

L'idée est de retrouver une ligne désirée en recherchant par mots clefs, l'exemple actuel répond parfaitement à ce besoin

Cependant, j'aurai aimé pouvoir modifier le contenu du paragraphe de la cellule description une fois une ligne recherchée et retrouvée.

C'est pour pour cela que j'ai besoin de connaitre le numéro de la ligne correspondant à la recherche sélectionnée.

Si je modifie la condition vérifiée dans ListBox1_Click, le numéro de la ligne apparait, mais cela ne verifie plus le contenu de la textbox 7

If Cells(L.Row, "B") <> TextBox3.Text Or Cells(L.Row, "C") <> TextBox4.Text Or Cells(L.Row, "D") <> TextBox5.Text Or Cells(L.Row, "E") <> TextBox6.Text Then

En éditant manuellement le contenu de la textbox liée à la cellule "Description" ( Textbox7) et en cliquant sur un nouveau bouton Enregistrer, le nouveau contenu est alors actualisé dans la cellule correspondante dans l'onglet ("BD")

Voici mon fichier actualisé.

Je ne vois pas de quoi il s'agit avec l'exemple de Boisgontier puis souvent on veut repartir d'un fichier existant et au final il faut repartir à 0

et là je ne comprends pas votre feuille. La colonne Chemin concerne quoi ?

Si je modifie la condition vérifiée dans ListBox1_Click, le numéro de la ligne apparait, mais cela ne verifie plus le contenu de la textbox 7

Que voulez-vous dire par "ne vérifie plus"

Lorsque vous éditez votre textbox7 et que vous cliquez sur Enregistrer, la ligne concernée est modifiée correctement

REM :

1. Aussi attention que votre tableau est au format structuré. Il ne faut jamais de ligne sans données de ce type de tableau. Dans votre exemple votre tableau doit s'arrêter en ligne 7. donc supprimez les lignes vides (sélectionnez A8 à Fx, puis click droite "Supprimer" --> "Lignes de tableau")
2. Suite au point1, le code Private sub initialize peut être simplifié comme ceci

Private Sub UserForm_Initialize()

Set f = Sheets("bd")
Me.ListBox1.List = f.ListObjects(1).DataBodyRange.Value
end sub

J'ai suivi votre conseils et supprimé les lignes vides du tableaux

Par contre, soudainement je constate que lorsqu'on clique sur une liste de la listbox, la selection apparait bien dans les textboxes correspondantes mais le n° de la ligne ne s'affiche plus dans LRow

Parfois, pour certaines lignes l'affichage de LRow s'affiche bien et pour d'autres ligne, non . LRow ne s'affiche plus.

je ne comprends pas ce qui génère cela .

Pouvez vous me dire pourquoi ?

J'ai besoin de connaitre la valeur de LRow car ça me sert pour modifier une ligne depuis le formulaire.

Ci joint mon nouveau fichier

1. Sub intialize : pourquoi voulez-vous faire des longueurs dans le code ?. L'USF est chargée en une ligne

Private Sub UserForm_Initialize()

Set f = Sheets("bd")
' Créer les headers dans une listbox header depuis Sheets("BD") ligne 2 :
Call CreateListBoxHeader(Me.ListBox_body, Me.ListBox_header, Array(f.Cells(1, "A"), f.Cells(1, "B"), f.Cells(1, "C"), f.Cells(1, "D"), f.Cells(1, "E"), f.Cells(1, "F")))
Call trier
Me.ListBox_body.List = f.ListObjects(1).DataBodyRange.Value
End Sub

2. Votre code de Tri, pourquoi vous utilisez une FUNCTION ?? et l'appeler par un CALL. Une fonction s'exécute toujours depuis une variable déterminée et définie dans un code et n'a jamais besoin d'un CALL
Votre code comme ceci.

Sub trier()
With Worksheets("BD").ListObjects("Tableau1")
    With .Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("Tableau1[Poste de travaux]"), SortOn:=xlSortOnValues, Order:=xlAscending
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub

3.

J'ai besoin de connaitre la valeur de LRow car ça me sert pour modifier une ligne depuis le formulaire.

Nul besoin. Il suffit de récupérer l'index de la listbox et la faire correspondre à votre tableau structuré. Ce sera toujours correct vu que vous trier la feuille BD et la listbox est chargée après le tri.

Je regarde ce point mais avant 2 questions :
- Pourquoi laissez-vous une ligne vide ? c'est à ne jamais faire avec VBA. Déjà le retour chariot n'est pas trop conseillé....
- Vous avec un code Textbox7 change avec une mention Textboxresultat. Je ne la voie pas dans l'uSF. Le code sert à quoi ?

Pourquoi laissez-vous une ligne vide ?

Voulez vous parler dans l’onglet « BD » ou bien dans les cellules, notamment dans les cellules de la colonne F ?

—

Textboxresultat va me servir plus tard à concaténer textbox7 avec une autre chaîne de caractère, l'idée à terme serait d'exporter le contenu sous Word.

—

Pouvez vous me montrer comment récupérer le numéro de la ligne sélectionnée via l'index de la listbox svp ?

Au vu de votre dernier fichier à quoi bon de vous proposer des modifications si vous ne les implémentez pas dans votre fichier. Je vais donc uniquement répondre à vos questions :

Voulez vous parler dans l’onglet « BD » ou bien dans les cellules, notamment dans les cellules de la colonne F ?

Oui dans la cellule F.

Pouvez vous me montrer comment récupérer le numéro de la ligne sélectionnée via l'index de la listbox svp ?

voici --> ListBox_body.ListIndex

Ensuite si cela vous intéresse, le code Private Sub Listbox_body_Click() se résume à ceci

Private Sub Listbox_body_Click()
Dim i As Byte

On Error Resume Next
For i = 1 To 7
    Me.Controls("Textbox" & i + 1) = ListBox_body.List(ListBox_body.ListIndex, i - 1)
Next i
End sub

REM : si vous conservez votre code au lieu de ce que je vous propose, la variable DerLig ne sert à rien. Vous pouvez la supprimer

Si terminé merci de clôturer le fil

Crdlt

Dans le dernier fichier que j'ai posté, j'avais désactivé votre nouvelle version dePrivate Sub UserForm_Initialize()car je n'avais pas réussi à le faire fonctionner avecPrivate Sub Listbox_body_Click() d'origine.

A présent, en remplaçant conjointement ces 2 sub par celles que vous avez proposé le code épuré fonctionne, je vous en remercie.

- - -

J'ai besoin d'avoir des sauts de lignes dans les contenus de la colonne F car je vais copier / coller ces contenus sont destinés à être dans Word par la suite.

- - -

Pouvez vous m'indiquer comment je peux maintenant renvoyer dans le formulaire, le numéro de la ligne dans ("BD") correspondante au choix sélectionné dans la Listbox ?

Cordialement,

A présent, en remplaçant conjointement ces 2 sub par celles que vous avez proposé le code épuré fonctionne, je vous en remercie.

1. La macro trier que je vous ai donnée n'est pas dans votre fichier. Vous avez toujours cette macro FUNCTION qui n'a pas de raison d'être (je vous l'ai déjà écrit et expliqué le pourquoi) et qui met le souc dans la feuille BD et dans la listbox.

2. Vous avez rajouté des lignes qui ne sont pas nécessaires à l'ouverture de votre USF. Votre souci est que vous appelez la sub initialize dans d'autres codes.
Là, si vous le voulez on peut l'éviter en modifiant deux codes. Cela vous éviterait de relancer des codes inutiles. Dites moi si cela vous intéresse.

Voici déjà le code "BsupprElement" que vous pouvez remplacer par celui ci-dessous :

Private Sub BSuppElement_Click()

If ListBox_body.ListIndex = -1 Then Exit Sub

If MsgBox("Voulez-vous supprimer cet élément ?", vbYesNo + vbDefaultButton2 + vbExclamation) = vbYes Then
    ' Suppression de la ligne contenant le client selectionné
    f.ListObjects(1).ListRows(ListBox_body.ListIndex + 1).range.Delete 'edit
    ListBox_body.RemoveItem (ListBox_body.ListIndex)

    MsgBox "Element supprimé", vbInformation, "Confirmation"
    Exit Sub
End If

MsgBox "Element non supprimé"
End Sub

Pouvez vous m'indiquer comment je peux maintenant renvoyer dans le formulaire, le numéro de la ligne dans ("BD") correspondante au choix sélectionné dans la Listbox ?

Remplacez le code Private Sub Listbox_body_Click() par celui ci

Private Sub Listbox_body_Click()
Dim i As Byte

On Error Resume Next
For i = 1 To 7
    Me.Controls("Textbox" & i + 1) = ListBox_body.List(ListBox_body.ListIndex, i - 1)
Next i

With Me
    .CheckBox1 = False
    .CheckBox2 = False
    .LRow = ListBox_body.ListIndex + 1
End With
End Sub

Mais je ne comprends toujours pas pourquoi vous voulez absolument avoir cette info LRow

J'ai besoin d'avoir des sauts de lignes dans les contenus de la colonne F car je vais copier / coller ces contenus sont destinés à être dans Word par la suite.

Ok mais comme vous avez un code txtboxresultat, vous pouvez très créer vos espaces dans cette textbox et avoir votre txtbox7 et cellule f sans les espaces

Autres points :

1. au dessus de vos codes remplacez DIM f par --> Dim f as worksheet
2. Dans Thisworkbook, remplacez le code par ceci plutôt

Private Sub Workbook_Open()
Call ouverture_formulaire
End Sub

J'ai apporté les corrections suggérées , merci à vous

J'ai adapté comme ceci :

.LRow = ListBox_body.ListIndex + 2 

car le tableau à une entête :

Private Sub Listbox_body_Click()

Dim i As Byte

On Error Resume Next
For i = 1 To 7
Me.Controls("Textbox" & i + 1) = ListBox_body.List(ListBox_body.ListIndex, i - 1)
Next i

With Me
.CheckBox1 = False
.CheckBox2 = False
.LRow = ListBox_body.ListIndex + 2               ' +1 car Listindex débute à partir de 0 et +1 car le tableau à une entête
End With

End Sub

Par contre, quand on recherche un mot clef en textbox 1 ,

l'erreur d'execution 9 " n'appartient pas à l'indice de selection apparait " à présent dans Private Sub TextBox1_Change()

---> For i = LBound(Tbl) To UBound(Tbl)

Pouvez vous m'expliquer d'où provient ce problème svp ?

Ok pour la correction du +2.

l'erreur d'execution 9 " n'appartient pas à l'indice de selection apparait " à présent dans Private Sub TextBox1_Change()

C'est dû à la variable Choix qui n'est plus définie. En remaniant la méthode que vous aviez et en remettant la définition de variable Choix dans le code Textbox1_change :

1. Remplacez le code Textbox1_change par celui ci-dessous

Private Sub TextBox1_Change()
Dim tbltmp()
Dim i As Integer, k As Integer, n As Integer
Dim mots, tbl, A
Dim choix()
Dim Ncol As Byte
Dim Rng As Range

Set Rng = f.ListObjects(1).DataBodyRange
tbltmp = Rng.Value
Ncol = Rng.Columns.Count

For i = LBound(tbltmp) To UBound(tbltmp)
    ReDim Preserve choix(1 To i)
    For k = LBound(tbltmp) To UBound(tbltmp, 2)
        choix(i) = choix(i) & tbltmp(i, k) & "*"
    Next k
Next i

If Me.TextBox1.Value = "" Then
    Me.Label1.Caption = ""
    Me.Label1.BackColor = vbWhite
    Me.ListBox_body.List = Rng.Value
End If

If Me.TextBox1 <> "" Then
    mots = Split(Trim(Me.TextBox1), " ")
    tbl = choix

    For i = LBound(mots) To UBound(mots)
        tbl = Filter(tbl, mots(i), True, vbTextCompare)
    Next i

    n = 0: Dim b()
    For i = LBound(tbl) To UBound(tbl)
        A = Split(tbl(i), "*")
        n = n + 1: ReDim Preserve b(1 To Ncol, 1 To n)
        For k = 1 To Ncol
            b(k, i + 1) = A(k - 1)
        Next k
    Next i

    If n > 0 Then
        ReDim Preserve b(1 To Ncol, 1 To n + 1)
        With Me.ListBox_body
            .List = Application.Transpose(b)
            .RemoveItem n
        End With
    End If

    If Not Me.TextBox1.Value = "" Then
        Me.Label1.Caption = UBound(tbl) + 1
        If UBound(tbl) + 1 > 0 Then
            Me.Label1.BackColor = vbGreen
            Me.Label1.ForeColor = vbBlack
        End If

        If UBound(tbl) + 1 = 0 Then
            Me.Label1.BackColor = vbRed
            Me.Label1.ForeColor = vbWhite
        End If
    End If
End If
End Sub

2. Au dessus de l'USF, supprimez la ligne Dim choix(), Rng, Ncol

Le code est complexe. J'avais tenté une autre méthode plus simple (via un code DO ... LOOP) mais pour aller plus vite pour vous répondre, j'ai conservé ce que vous aviez dans ce code Textbox1_change en modifiant un peu le début.

Rem :
- Pourquoi avez-vous mis un bouton X à droite de la textbox1.
- Le code Private Sub BCreerElement_Click() pourrait être adapté vu que votre tableau est au format structuré. A voir si vous voulez...

Merci beaucoup pour le code corrigé, il fonctionne parfaitement.

Le bouton X est destiné à effacer en un clic une saisie dans la textbox de recherche et ainsi re-initialiser la ligne surligné dans la Listbox, un sorte de bouton Reset en fait.

Je veux bien voir l'optimisation de Sub BCreerElement_Click() c'est toujours instructif les codes bien écrits.

Merci beaucoup pour le code corrigé, il fonctionne parfaitement

Ok. Vous verrez que si vous videz manuellement la textbox, la listbox se modifie aussi

Je veux bien voir l'optimisation de Sub BCreerElement_Click() c'est toujours instructif les codes bien écrits.

Voici les modifications à faire :

1. Remplacez la sub Sub Initialize par celle ci-dessous (désolé, je vous avais donné une autre version avant mais vu les modif, on peut simplifier) :

Private Sub UserForm_Initialize()
Set f = Sheets("bd")

' Créer les headers dans une listbox header depuis Sheets("BD") ligne 2 :
Call CreateListBoxHeader(Me.ListBox_body, Me.ListBox_header, Array(f.Cells(1, "A"), f.Cells(1, "B"), f.Cells(1, "C"), f.Cells(1, "D"), f.Cells(1, "E"), f.Cells(1, "F")))
Call trier

Me.ListBox_body.List = f.ListObjects(1).DataBodyRange.Value
End Sub

2. En dessous, ajoutez la macro ci-dessous :

Private Sub effacer()
With Me
    .CheckBox1 = False
    .CheckBox2 = False
    .TextBox1 = vbNullString
    .LRow.Caption = ""
    .LRow.BackColor = &HE0E0E0
    .TextBox2 = vbNullString
    .TextBox7 = vbNullString
    .TextBoxResultat = vbNullString
End With
End Sub

3. remplacez le code BCreerElement_Click par celui ci-dessous

Private Sub BCreerElement_Click()
Dim Lig As Integer
Dim i As Byte

If Not Me.TextBox2 = vbNullString And Not Me.TextBox7 = vbNullString Then
    With f.ListObjects(1)
        If .ListRows.Count = 0 Then
            .ListRows.Add: Lig = 1
        Else: .ListRows.Add: Lig = .ListRows.Count 'insérer à la dernière ligne
        'Else: .ListRows.Add Position:=1: Lig = 1 'insérer a la 1igne 1
        End If

        With .DataBodyRange
            For i = 1 To 6
                .Item(Lig, i) = Me.Controls("TextBox" & i + 1)
            Next i
        End With

        Call trier
        Call effacer 'au lieu de UserForm_Initialize
    End With

    Else
        MsgBox "Intitulé et description non remplis", vbInformation, "Attention"
    End If
End Sub

Faites un test...

Reste la sub BUpdate_Click à revoir, si ok pour vous sur les modifications ci-dessus.

Pour le bouton X, il sert juste à vider la textbox de recherche pour réinitialiser la listbox si je comprends bien ?. Cette question parce que aves les modifications apportées vous pourriez aussi appeler le code Effacer

Merci beaucoup pour les explications et le temps passé.

Re

1. Voici la sub pour l'UPdate

Private Sub BUpdate_Click()
Dim previous_checkbox_state As Integer

If ListBox_body.ListIndex = -1 Then
    MsgBox "Mise à jour impossible : pas de n° de ligne pour cet élement"
    Exit Sub
End If

previous_checkbox_state = 0

' si la checkbox à été préalablement selectionnée
If Me.CheckBox2 = True Then previous_checkbox_state = 1

Dim i As Byte

With f
    With .ListObjects(1)
        LRow = ListBox_body.ListIndex + 1
        .DataBodyRange(LRow, 1) = UCase(LTrim(Me.TextBox2))

        For i = 2 To 6
            .DataBodyRange(LRow, i) = LTrim(Me.Controls("TextBox" & i + 1))
        Next i

        MsgBox "Mise à jour base de données effectuée", , "Update"
        Me.ListBox_body.ListIndex = -1
        Me.ListBox_body.List = .DataBodyRange.Value 'mise à jour listbox_body
    End With

    Call effacer

    ' Retabli la case si celle-ci était cochée avant la sauvegarde de l'élément
    If previous_checkbox_state = 1 Then Me.CheckBox2 = True
End With
End Sub

2. La ligne Dim ligne_depart_source As Long peut être supprimée.

Faites un test.

NB : Vérifiez cote "previous_checkbox_state" si cela fonctionne bien comme vous voulez car ne sachant pas comment vous fonctionnez je n'ai pas fait de test à ce sujet.

Reste bouton X cité dans mon post précédent et auquel vous n'avez pas répondu. A mon avis il faut juste cette ligne --> Call Effacer au lieu d'appeler la sub initialize