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 ?
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
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