Coller automatiquement la suite d'un texte d'un textbox au suivant
Dans ton exemple ça fonctionne très bien, mais quand je le transpose dans mon projet ( j'ai mis le ScrollBa) il bute sur
ScrollBar1.Value = Abs(TblPos(MultiPage1.SelectedItem.Index + 1))
"L'indice n'appartient pas à la sélection"
Je pense que ça vient du fait que les TextBox en question ne commencent qu'à la page 3 (3 à 14), les deux premières pages étant occupées par des renseignements généraux.
Pour les exemples précédents, j'avais placé +3 au bon endroit, mais là, NBPage = Int(Len(Texte) / L) + 3 ne solutionne pas le problème
Bonjour,
Je te reposte tout le code modifié pour prendre en compte les pages d'introduction (ici, 2) je n'ai juste pas mis tes deux procédures événementielles Imprimer et Fermer :
Dim TblPos() As Long '<--- pour mémoriser la position du ScrollBar pour chaque page
Dim I As Long
Dim J As Long
Dim L As Long
Const NBPIntro As Integer = 2 'nombre de pages d'introduction
'à 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 = TextBox4.Height 'ici, c'est à voir par rapport au texte affiché !
.SmallChange = 10
.LargeChange = 100
End With
Me.MultiPage1.Value = 0
ScrollBar1.Enabled = False
End Sub
Private Sub MultiPage1_Change()
If MultiPage1.SelectedItem.Index < NBPIntro Then
ScrollBar1.Value = 0
ScrollBar1.Enabled = False
Exit Sub
Else
With MultiPage1.SelectedItem
'si il y a du textedans le TextBox, active le ScrollBar
If .Controls("TextBox" & .Index + 1).Text <> "" Then ScrollBar1.Enabled = True
End With
End If
If Not (Not TblPos) Then 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
'si pas de texte, fin
If .Controls("TextBox" & .Index + 1).Text = "" Then Exit Sub
.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(NBPIntro + 1 To NBPage + NBPIntro)
'cache les pages inutiles
For I = MultiPage1.Pages.Count To NBPage + NBPIntro + 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 = NBPIntro 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 SubMerci Theze pour tout ce travail,
ça marche très bien dans le petit programme d'essai, mais la transposition dans mon projet affiche le texte à partir du troisième TextBox, ce qui est logique puisque j'ai écrit que les deux premières pages contenaient d'autres informations, mais elles ne contiennent pas de Textbox, en tout cas pas sous ce nom, mais TextIdentite1, 2, 3, etc... (désolé de ne pas l'avoir signalé avant)
J'ai essayé de modifier la position et la valeur de NBPIntro, mais le début du texte à afficher ne commence alors qu'à partir du troisième TextBox ou c'est seulement le troisième TextBox qui apparaît ...
J'imaginais une procédure dont je ne sais pas si elle est réalisable : puisque je pars d'un ListBox dont les longueurs de lignes ne sont pas contrôlables par définition (que j'alimente avec des données provenant de nombreuses cellules et se répartissant ainsi : Date, 5 à 15 lignes de texte puis je place une ligne de tirets pour finir le paragraphe ) et dont je transfère ensuite le contenu dans une cellule unique pour garder la disposition des lignes puis que je récupère dans les TextBox en question pour avoir des retours à la ligne; je pensais qu'il était peut-être possible d'agir en amont en plaçant dans le ListBox du début, après la ligne de tirets la plus proche des X caractères souhaitables, un code qui renverrait au TextBox suivant ?
Je rêve ou c'est envisageable ?
Re,
Si tu peux poster ton fichier qui sera définitif ça pourrait aider !
Re,
je vais te mettre le code que j'utilise pour les étapes précédant l'affichage dans les TextBox.
Re,
Voici le fichier, l'original est très volumineux (8 feuilles, 18 UserForm) et surtout contient des données sensibles.
Ca m'a donc pris pas mal de temps de le réduire à cela.
Le principe - si c'est possible - serait de couper le texte après une ligne pointillée avant d'arriver au nombre de caractères max défini par ailleurs (environ 1500 à 7000) selon la longueur des lignes.
If Len(ListBox1.List) > 2000 then ...
Mais après je ne sais plus...
Suis-je bête : on a le nombre de lignes (ListBox1.ListCount) ce qui est bien plus constant (environ 50 par page) que le nombre de caractères, mais je ne sais toujours pas comment résoudre le problème
Bonjour,
Suis-je bête : on a le nombre de lignes (ListBox1.ListCount) ce qui est bien plus constant (environ 50 par page) que le nombre de caractères, mais je ne sais toujours pas comment résoudre le problème
Connaître le nombre de lignes de la ListBox ne sert pas à grand chose quand on récupère le texte dans une cellule !
Soit, une fois tous les paragraphes dans la ListBox, on les récupère directement dans un tableau, soit, si il faut absolument qu'ils passent par une cellule, on utilise des balises de séparation et on travaille par rapport à celles-ci. C'est cette dernière solution que j'ai utilisé dans le code ci-dessous et les balises sont des caractères invisibles (Alt+255). Testes pour voir le résultat. Attention, j'ai ramené toutes les variables déclarées en tête de module (sauf ws) dans la procédure (il ne sert à rien d'utiliser inutilement de la mémoire une fois la procédure terminée) :
Private Sub Label230_Click()
Dim TblPos() As Long
Dim Texte As String
Dim NBPage As Integer
Dim Debut As Long
Dim Fin As Long
Dim Pos As Long
Dim I As Long
Dim J As Long
Dim L As Long
Const NBPIntro As Integer = 2 'nombre de pages d'introduction
Set Ws = Sheets("Feuil1") 'correspond au nom de la FEUILLE
For I = 1 To 12
'j'ai mis n'importe quoi, juste pour alimenter la cellule "A1"
ListBox1.AddItem "paragraphe " & I & " :"
ListBox1.AddItem Ws.Cells(1, "B")
If Ws.Cells(1, "C").Value <> "" Then ListBox1.AddItem Ws.Cells(1, "C")
If Ws.Cells(1, "D").Value <> "" Then ListBox1.AddItem Ws.Cells(1, "D")
If Ws.Cells(1, "E").Value <> "" Then ListBox1.AddItem Ws.Cells(3, "E")
If Ws.Cells(1, "F").Value <> "" Then ListBox1.AddItem Ws.Cells(4, "F")
If Ws.Cells(1, "G").Value <> "" Then ListBox1.AddItem Ws.Cells(5, "G")
If Ws.Cells(1, "H").Value <> "" Then ListBox1.AddItem Ws.Cells(6, "H")
If Ws.Cells(1, "I").Value <> "" Then ListBox1.AddItem Ws.Cells(7, "I")
If Ws.Cells(1, "J").Value <> "" Then ListBox1.AddItem Ws.Cells(8, "J")
If Ws.Cells(1, "K").Value <> "" Then ListBox1.AddItem Ws.Cells(9, "K")
If Ws.Cells(1, "L").Value <> "" Then ListBox1.AddItem Ws.Cells(10, "L")
'on rajoute une ligne de pointillés
ListBox1.AddItem Ws.Cells(1, "Q")
'insère un caractère invisible (Alt+255) pour matérialiser la fin d'un paragraphe
ListBox1.AddItem " "
Next I
'Sauvegarde dans "A1"
For I = 0 To ListBox1.ListCount - 1
Texte = Texte & Chr(10) & ListBox1.List(I)
Next I
'Texte = Replace(Texte, Chr(10), "")'<--- pourquoi ?
With Sheets("Feuil1").Range("A1")
.Value = Texte
.WrapText = True
End With
'Transfert des données dans TextBox1, TextBox2, TexBox3...
Texte = Sheets("Feuil1").Range("A1").Value
L = 1500 '<---- quoi faire de la longueur maxi ?
If Texte = "" Then Exit Sub
'recherche les positions des caractères invisibles qui séparent chaque paragraphe
For I = 1 To Len(Texte)
Pos = InStr(I, Texte, " ") '<--- caractère invisible (Alt+255)
If Pos <> 0 Then
J = J + 1: ReDim Preserve TblPos(1 To J)
TblPos(J) = Pos
I = Pos + 1
End If
Next I
'défini le nombre de pages nécessaire (donné par le nombre de tirets bas)
NBPage = UBound(TblPos)
'cache les pages inutiles
For I = MultiPage1.Pages.Count To NBPage + NBPIntro + 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
'découpe le texte pour l'afficher sur les différentes pages
For I = NBPIntro To MultiPage1.Pages.Count - 1
'si on arrive au bout, fin
If MultiPage1.Pages(I).Visible = False Then Exit For
Fin = TblPos(I - NBPIntro + 1)
'inscrit dans les TextBox les différents paragraphes en supprimant les caractères invisibles
Me.Controls("TextBox" & I - NBPIntro + 1).Text = Replace(Mid(Texte, Debut, Fin - Debut), " ", "")
Debut = TblPos(I - NBPIntro + 1) + 1
Next I
End SubBonjour Theze,
merci pour ce travail !
Ca fonctionne bien, mais - je sais, j'abuse - j'aurais souhaité avoir le maximum de paragraphes par page (les paragraphes peuvent avoir de 5 à 15 lignes et des lignes de longueur variable qui peuvent parfois dépasser la largeur de la page), c'est pourquoi je pensais - peut-être à tort - qu'on pouvait renvoyer chaque paragraphe ou plutôt chaque bloc de page (plusieurs paragraphes, environ 50 lignes) dans une cellule différente (A1, A2...) puis réimporter les cellules dans les différentes TextBox des pages.
Pour chaque numéro de référence, il peut y avoir jusqu'à 99 évènements de 5-15 lignes, ce qui tient sur 12 pages, le but étant d'en faire un PDF à imprimer.
Tu m'as déjà appris beaucoup et je comprendrai parfaitement que tu n'as pas que ça à faire et que tu laisses tomber.