Coller automatiquement la suite d'un texte d'un textbox au suivant

Bonjour à toutes et à tous,

je récupère dans une cellule les données d'un Listbox (lui-même alimenté par de nombreux Aditem) et je les envoie dans un Textbox1 afin d'avoir des retours à la ligne qui n'existent pas dans les Listbox, pour pouvoir ensuite les imprimer en PDF (je sais c'est un peu tordu, mais ça marche bien pour la mise en page de cet Userform multipage, tant que le texte ne dépasse pas la longueur de la page).

Cependant, il arrive que le texte soit plus long que le Textbox1 (plus long que la page en fait). Est-il possible de faire que le texte se continue automatiquement du Textbox1 au Textbox2 (sur la page suivante de l'Userform multipage) une fois le bas de la page atteint ?

J'ai essayé sans succès le code suivant en le modifiant autant que j'ai pu :

If Len(Textboxt1) = Textbox1.MaxLength - 1 Then

Textbox1 = Textbox1 + Chr(10)

Textbox2.SetFocus

End If

Merci d'avance à qui voudra bien se pencher sur le problème

Bonjour,

Ton code fonctionne, à utiliser sur la procédure événementielle Change() du TextBox1 (attention à la faute de frappe dans ton code"Len(Textboxt1)" --->"Len(TextBox1)") :

Private Sub TextBox1_Change()

    If Len(TextBox1.Text) = TextBox1.MaxLength - 1 Then

    TextBox1.Text = TextBox1.Text + Chr(10)
    TextBox2.SetFocus

    End If

End Sub

Merci Theze pour ta réponse, mais chez moi ça ne fonctionne pas, même après avoir corrigé la faute de frappe : rien n'apparait dans le Textbox2 alors que le texte fait près de deux pages A4 et le Textbox1 fait 3/4 de page (je voudrais que le passage de l'un à l'autre soit automatique, sans aucune autre intervention, alors que la remplissage du Textbox1 se fait simplement avec :

TextBox1.Value = Sheets("Feuille").Cells(1, "A")

Je suppose que TextBox1.Text = TextBox1.Text + Chr(10) nécessite la frappe d'au moins 1 caractère, ce qui n'est donc pas automatique.

Bonjour,

Je pensais que le texte était saisie à la main dans le TextBox !

Dans ton cas, c'est un poil plus compliqué car tu colle tout le texte en une seule fois et c'est dans cette procédure qu'il faut gérer les deux parties, la première partie qui doit se trouver dans le TextBox1 et la seconde dans le TextBox2 et que la coupure entre les deux se fasse au niveau d'un espace. La procédure ci-dessous attachée à la procédure événementielle Click() du bouton fait cela :

Private Sub CommandButton1_Click()

    Dim I As Long
    Dim L As Long
    Dim Texte As String
   Dim Partie_1 As String
    Dim Partie_2 As String

    Texte = Sheets("Feuille").Range("A1")
    L = TextBox1.MaxLength

    'au cas où la cellule est vide
    If Texte = "" Then Exit Sub

    'si le texte est supérieur à la longueur admise - 1...
    If Len(Texte) > L - 1 Then

        'si on ne tombe pas sur un espace...
        If Mid(Texte, L - 2, 1) <> " " Then

            'boucle en redescendant à la recherche du premier espace trouvé
            'et scinde le texte en deux puis fin de boucle
            For I = L - 2 To 1 Step -1

                If Mid(Texte, I, 1) = " " Then

                    Partie_1 = Left(Texte, I - 1) & vbCrLf
                    Partie_2 = Right(Texte, Len(Texte) - I)
                    Exit For

                End If

            Next I

       'si on tombe sur un espace, scinde le texte à cet endroit
        Else

            Partie_1 = Left(Texte, L - 2) & vbCrLf
            Partie_2 = Right(Texte, Len(Texte) - L + 2)

        End If

    'le texte est inférieur à la longueur maxi
    Else

        Partie_1 = Texte

    End If

    'inscription dans le ou les TextBox selon le cas
    TextBox1.Text = Partie_1
    TextBox1.SetFocus

    If Partie_2 <> "" Then

        TextBox2.Text = Partie_2
        TextBox2.SetFocus

    End If

End Sub

Merci Theze mais chez moi ça ne marche toujours pas : et j'essaie différentes combinaisons depuis ce matin notamment en simplifiant :

Dim I As Long

Dim L As Long

Dim Texte As String

Dim Partie_1 As String

Dim Partie_2 As String

Texte = Sheets("Feuille").Range("A1")

L = TextBox1.MaxLength

If Len(Texte) > L - 1 Then

Partie_1 = Left(Texte, L - 2) & vbCrLf

Partie_2 = Right(Texte, Len(Texte) - L + 2)

TextPort1.Text = Partie_1

TextPort2.Text = Partie_2

End If

End Sub

Au mieux, je n'obtiens du texte que dans le Textbox2

les propriétés du Textbox1 sont

AutoSize = False,

AutoTab = True,

MaxLength = 0,

MultiLine = True

WordWrap = True

Y-a t-il quelque chose que je n'aurais pas compris ?

Re,

Je te poste un classeur exemple !

Génial !

Je n'avais pas compris qu'il fallait fixer manuellement la longueur du texte acceptable par le Texbox1 (je pensais que le nombre de caractères ne pouvait pas être plus grand que sa dimension physique).

Il faut donc tâtonner pour trouver arbitrairement le nombre de lignes (caractères) acceptable par le TextBox à moins qu'il existe une façon simple de le déterminer ?

Merci infiniment !

Bon WE

Bonjour,

Effectivement, il te faut tâtonner pour trouver le nombre de caractères maximal afin que le texte ne dépasse pas la zone d'affichage du TextBox.

Il serait possible de calculer la longueur du texte et par différents calculs trouver la longueur de texte pour ne pas dépasser la limite mais il faut utiliser les Apis Windows et ça va vite devenir une usine à gaz !

Bonjour Theze,

Avec le nombre de lignes récupéré dans le premier ListBox et le nombre de caractères récupéré récupéré dans le second, je vais faire une moyenne (pour moi 3000 caractères) et le Textbox sera a peu près correctement rempli.

Je teste en cliquant en bas de la page pour voir s'il affiche des lignes supplémentaires.

Encore merci.

Bonne journée.

Bonsoir Theze,

je me permets de rouvrir le sujet (je récupère dans une cellule les données d'un Listbox (lui-même alimenté par de nombreux Aditem) et je les envoie dans un Textbox1 afin d'avoir des retours à la ligne qui n'existent pas dans les Listbox, pour pouvoir ensuite les imprimer en PDF ).

Ta solution fonctionne très bien, mais comme le Multipage a une douzaine de pages, je voulais les traiter automatiquement avec une boucle, mais ça ne marche pas :

Dim Texte As String

Dim i As Long

Dim L As Long

For i = 1 To 12

Texte = Sheets("feuille").Range("A1")

L = TextBox1.MaxLength

L = 3500

'au cas où la cellule est vide

If Texte = "" Then Exit Sub

'si le texte est supérieur à la longueur admise - 1...

If Len(Texte) > L - 1 Then

Me.Controls("TextBox" & i).Text = Left(Texte, L - 1) '& vbCrLf

Me.Controls("TextBox" & i + 1).Text = Right(Texte, Len(Texte) - L + 1)

'si le texte est inférieur à la longueur maxi

Else

Me.Controls("TextPort" & i).Text = Texte

'Suppression des pages inutiles

For j = (i + 1) To 12

MultiPage1.Pages(j).Visible = False

Next j

Next i

Exit Sub

Il semble que ce soit "Me.Controls("TextBox" & i + 1).Text" qui n'est pas pris en compte

Bonjour,

Je dois dire que j'ai de la peine à comprendre ton code !

Tu boucles sur 13 TextBox et tu leurs affectes, pour les uns la première partie du texte et pour les autres la seconde mais avec ces lignes de code :

Me.Controls("TextBox" & i).Text = Left(Texte, L - 1) '& vbCrLf
Me.Controls("TextBox" & i + 1).Text = Right(Texte, Len(Texte) - L + 1)

tu écrases le texte précédemment entré !

Exemple, I est à 1 donc, TextBox1 reçoit la première partie du texte et TextBox2 la seconde quand I passe à 2, TextBox2 reçoit la première partie du texte à son tour ce qui efface le seconde partie précédemment reçu donc et ainsi de suite, ça n'a pas de sens !

Si c'est ce que tu veux (TextBox1=1ère partie, TextBox2=2ème partie puis TextBox3=1ère partie, TextBox4=2ème partie) il te faut faire un pas de 2 avec Step 2

For i = 1 To 12 Step 2

Pour que je puisse y voir plus clair, postes un classeur exemple.

Merci de continuer à me driver.

Je n'avais pas pensé à "Step 2" (ça fait un an que je m'exerce au VBA (des centaines d'heures), mais j'ai encore beaucoup à apprendre)

Ci-joint un fichier très simplifié et je ne m'occupe pas pour l'instant du point de césure du texte.

  • Tu verras qu'il répète indéfiniment les pages 1 et 2 et que je ne sais pas en sortir...
  • que la suppression des pages blanches ne fonctionne pas

Merci d'avance

17essai.xlsm (61.21 Ko)

Re,

Je suppose que tu souhaites afficher le texte morcelé sur les différentes pages et cacher celles qui ne sont pas utiles ?

Voici un code qui fait ça sans pour l'instant découper le texte à hauteur d'un espace car si ce n'est pas ce que tu désire comme résultat, je ne veux pas me creuser la tête pour rien

Private Sub Label230_Click()

    Dim Texte As String
    Dim NBPage As Integer
    Dim Pos As Long

    Texte = Sheets("Feuil1").Range("A1").Value
    L = 7000
    If Texte = "" Then Exit Sub

    'défini le nombre de pages nécessaire
    NBPage = Int(Len(Texte) / L) + 1

    'cache les pages inutiles
    For I = MultiPage1.Pages.Count To NBPage + 1 Step -1: MultiPage1.Pages(I - 1).Visible = False: Next I

    'position du 1er caractère de la feuille en cours (1 pour le début)
    Pos = 1

    'découpe le texte pour l'afficher sur les différentes pages
    For I = 0 To MultiPage1.Pages.Count - 1

        Me.Controls("TextBox" & I + 1).Text = Mid(Texte, Pos, L)
        Pos = Pos + L

    Next I

End Sub

Génial : c'est exactement ce que je souhaitais.

J'admire, l'économie de moyens pour la qualité du résultat

Mille merci Theze

Re,

OK, donc dès que j'ai le temps, je regarde pour morceler le texte au niveau des espaces !

Bonjour,

Voici le code avec découpe au niveau d'un espace :

Private Sub Label230_Click()

    Dim Texte As String
    Dim NBPage As Integer
    Dim Debut As Long
    Dim Fin As Long

    Texte = Sheets("Feuil1").Range("A1").Value
    L = 7000
    If Texte = "" Then Exit Sub

    'défini le nombre de pages nécessaire
    NBPage = Int(Len(Texte) / L) + 1

    'cache les pages inutiles
    For I = MultiPage1.Pages.Count To NBPage + 1 Step -1: MultiPage1.Pages(I - 1).Visible = False: Next I

    'position du 1er caractère de la feuille en cours (1 pour le début)
    Debut = 1
    Fin = L

    'découpe le texte pour l'afficher sur les différentes pages
    For I = 0 To MultiPage1.Pages.Count - 1

        'recheche le premier espace pour couper à ce niveau
        If Mid(Texte, Fin, 1) <> " " Then

            For J = Fin To 1 Step -1

                If Mid(Texte, J, 1) = " " Then Fin = J: Exit For

            Next J

        End If

        'si on arrive au bout, fin
        If MultiPage1.Pages(I).Visible = False Then Exit For

        Me.Controls("TextBox" & I + 1).Text = Mid(Texte, Debut, Fin - Debut)
        Debut = Fin + 1
        Fin = Debut + L

    Next I

End Sub

Je pense que le texte contient des caractères spéciaux qui font que la longueur du texte est légèrement supérieure à la longueur maxi voulue donc, il ne te faut pas définir la propriété MaxLength afin que ces quelques caractères soient dans le TextBox et puis de toute façon, c'est toi qui en défini la longueur.

Je vais creuser un peu pour voir pourquoi dans la fonction Mid() je défini une longueur maxi et quand je compte le nombre de caractères dans les TextBox j'en ai 20 ou 30 de plus ? Je te tiens au courant si je trouve !

Bonjour Theze,

C'est encore mieux comme ça : je n'en espérait pas tant !

Bien sûr je suis preneur de toutes les améliorations possibles.

Comme il n'est pas possible de compter le nombre de lignes qui varie en fonction de la longueur de celles-ci, je pensais ajouter une commande permettant de faire varier le nombre de caractères pour approcher le bas de la page, mais je m'aperçois que ce qui est valable pour une page ne le sera pas forcément pour les suivantes

Bonne journée

Re,

Bon et bien effectivement il y a dans le texte des caractères spéciaux qui ne sont pas pris en considération dans la fonction Mid() dont il est possible de connaître le nombre en utilisant la fonction EPURAGE() (CLEAN() en Anglais) en B1 qui vire tous ces caractères et avec NBCAR() sur A1 et B1, la différence est de 102 caractères.

En utilisant Clean() dans le code et en mettant un Label où j'inscris la longueur de texte des TextBox sur l'événement Change() du MultiPages, aucun ne dépasse 3500 (c'est la valeur que j'ai défini pour mes tests) mais le texte en moins bien mis en valeur alors qu'en n'utilisant pas la fonction Clean(), j'ai un peu plus de 3500 caractères (la différence étant ces caractères spéciaux) mais le texte est mieux présenté et donc plus facile à lire !

Je regarde pour utiliser un contrôle ScrollBar afin de faire défiler le TextBox de haut en bas et vice-versa !

Re-bonjour,

Je ne t'ai pas précisé que j'ai pris arbitrairement le texte d'un livre pour avoir une base à découper, mais le vrai texte est une suite de compte-rendus de 5 à 15 lignes (le plus souvent incomplètes), commençant par une date et finissant par une ligne de tirets que j'ai placé automatiquement à la fin de chaque compte-rendu pour bien marquer la séparation.

Peut-être serait-il possible d'y inclure un caractère spécial qui déclencherait la césure du texte en bas de page ?

Me revoilà !

Je te poste ton classeur avec les modifs que j'ai faites !

J'ai rajouté un contrôle ScrollBar pour faire défiler les TextBox (il est commun à tous les TextBox) car j'utilise un tableau pour mémoriser la position pour chaque feuille. Le seul soucis avec le ScrollBar de Microsoft, c'est que quand on l'utilise, son bouton clignote et ce n'est pas top mais bon, il est possible de donner le focus à un autre contrôle juste après mais ça ne marche pas à tout les coups.

Je poste le code complet de l'UserForm et le classeur, tu choisis quoi prendre.

Le classeur :

Le code (attention de ne pas oublier de rajouter le ScrollBar) :

Dim I As Long
Dim J As Long
Dim L As Long
Dim TblPos() As Long '<--- pour mémoriser la position du ScrollBar pour chaque page

'à l'initialisation de l'userform
Private Sub UserForm_Initialize()

    Dim Ctrl As Control

    'positionne tous les TextBox avec une marge de 10
    For I = 0 To Me.MultiPage1.Pages.Count - 1

        For Each Ctrl In Me.MultiPage1.Pages(I).Controls

            If TypeName(Ctrl) = "TextBox" Then

                Ctrl.Top = 10
                Ctrl.Left = 10
                Ctrl.Width = MultiPage1.Width - 20
                Ctrl.Height = MultiPage1.Height - 20

            End If

        Next Ctrl

    Next I

    'défini quelques propiété du ScrollBar
    With ScrollBar1

        .Min = 0
        .Max = TextBox1.Height 'ici, c'est à voir par rapport au texte affiché !
        .SmallChange = 10
        .LargeChange = 100

    End With

    Me.MultiPage1.Value = 0

End Sub

'Impression
Private Sub Label192_Click()
    Me.PrintForm
End Sub

'Fermer UsFEXPORT
Private Sub Label196_Click()
    Unload UsFEXPORT
End Sub

Private Sub MultiPage1_Change()

    'positionne le ScrollBar comme il était au moment de quitter la page
    '(la modification de sa valeur engendre d'office son événement Change ci-dessous)
    ScrollBar1.Value = Abs(TblPos(MultiPage1.SelectedItem.Index + 1))

End Sub

Private Sub ScrollBar1_Change()

    'la descente du bouton du ScrollBar fait monter le TextBox de la page active (valeur négative avec -)
    With MultiPage1.SelectedItem

        .Controls("TextBox" & .Index + 1).Top = -ScrollBar1.Value
        TblPos(.Index + 1) = -ScrollBar1.Value
        '.Controls("TextBox" & .Index + 1).SetFocus '<-- évite un peu le clignotement mais bon, c'est pas top !

    End With

End Sub

Private Sub Label230_Click()

    Dim Texte As String
    Dim NBPage As Integer
    Dim Debut As Long
    Dim Fin As Long

    Texte = Worksheets("Feuil1").Range("A1").Value
    L = 7000
    If Texte = "" Then Exit Sub

    'défini le nombre de pages nécessaire
    NBPage = Int(Len(Texte) / L) + 1

    'dimensionne le tableau par rapport au nombre de pages qui va recevoir la position du ScrollBar
    'pour chacune d'entre elles
    ReDim TblPos(1 To NBPage)

    'cache les pages inutiles
    For I = MultiPage1.Pages.Count To NBPage + 1 Step -1: MultiPage1.Pages(I - 1).Visible = False: Next I

    'position du 1er caractère de la feuille en cours (1 pour le début)
    Debut = 1
    Fin = L

    'découpe le texte pour l'afficher sur les différentes pages
    For I = 0 To MultiPage1.Pages.Count - 1

        'recheche le premier espace pour couper à ce niveau
        If Mid(Texte, Fin, 1) <> " " Then

            For J = Fin To 1 Step -1

                If Mid(Texte, J, 1) = " " Then Fin = J: Exit For

            Next J

        End If

        'si on arrive au bout, fin
        If MultiPage1.Pages(I).Visible = False Then Exit For

        Me.Controls("TextBox" & I + 1).Text = Mid(Texte, Debut, Fin - Debut)

        Debut = Fin + 1
        Fin = Debut + L

    Next I

End Sub
Rechercher des sujets similaires à "coller automatiquement suite texte textbox suivant"