Discussion :

[jonathan.chaf]

Bonjour,
Je cherche a remplacer une cellule ayant des retours de ligne automatique en nouvelle ligne
En gros faire ce qui a dessous :


J'ai essayer de m'inspirer de certain code comme ceux ci :

"ici on decoupe le texte d'une textbox par ligne mais selement avec les sauts de lignes"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub CommandButton1_Click()
Dim montexte() As String
Dim Maligne As Integer
With TextBox1
   'Découpe le contenu de la textbox par ligne
    montexte = Split(.Text, vbCrLf)
   'Parcourt le tableau montext (=chaque ligne). Ubound renvoie le numéro du dernier élément du tableau
    For Maligne = 0 To UBound(montexte)
         'Ecrit chaque ligne dans la cellule correspondante
        Feuil1.Cells(Maligne + 1, 1).Value = montexte(Maligne)
 
    Next Maligne
End With
End Sub

"Et ici on compte le nombre de ligne d'une textbox saut de ligne et retour à la ligne compris"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub TextBox9_Change()
    TextBox9.SetFocus 'limite le nombre de ligne
    If Me.TextBox9.LineCount <= 4 Then
        Tampon1 = Me.TextBox9.Text
    Else
        MsgBox "Le nombre de lignes doit être inférieur à 5"
        Me.TextBox9.Text = Tampon1
    End If
End Sub

Le texte a découper peut provenir d'une textbox si besoin.
Le mieux ce serai d'arriver à trouver l'endroit du saut de ligne et le remplacer avec ";" afin que je remplisse une petite base de données pour que je puisse récupérer la ligne et la copier sur une ou plusieurs feuille excel afin de l'imprimer sans avoir des sauts de pages n'import ou.

[halaster08]

Bonjour,

Mis a part le textbox (que tu peux remplacer par with range("A11") pour faire faire correspondre a ton exemple) je ne comprends pas ce que tu reproche au premier code que tu as montrer.

Le mieux ce serai d'arriver à trouver l'endroit du saut de ligne et le remplacer avec ";" afin que je remplisse une petite base de données pour que je puisse récupérer la ligne et la copier sur une ou plusieurs feuille excel afin de l'imprimer sans avoir des sauts de pages n'import ou.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range("A11").replace(vbCrLf,";")

[jonathan.chaf]

Je peux effictivement faire ça :

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
 
Private Sub CommandButton1_Click()
Dim montexte() As String
Dim Maligne As Integer
With Range("A11")
   'Découpe le contenu de la textbox par ligne
    montexte = Split(.Text, vbCrLf)
   'Parcourt le tableau montext (=chaque ligne). Ubound renvoie le numéro du dernier élément du tableau
    For Maligne = 0 To UBound(montexte)
         'Ecrit chaque ligne dans la cellule correspondante
        Feuil1.Cells(Maligne + 1, 1).Value = montexte(Maligne)
 
    Next Maligne
End With
End Sub

Mais en réalité je n'ai qu'un vrai saut de ligne le reste est réalisé par Excel grâce au renvoie à la ligne automatique. Donc il ne trouve pas ces saut là et c'est surtout ceux ci que je cherche a remplacer par de vrai saut de ligne.

[unparia]

Bonjour
J'ai déjà eu l'occasion d'expliquer que la gestion par Excel de l'affichage dans une cellule n'était en aucun cas identique à celui de l'affichage dans une textbox. Excel (dont la vocation est celle d'un tableur et non d'un traitement de texte) décide "au mieux selon lui", en fonction du texte, de la police de caractères, etc ... de l'ajustement de la marge gauche de la cellule. Le même texte, écrit avec les mêmes caractéristiques de police, affiché dans une textbox et dans une cellule de même largeur ne sera pas "découpé" de la même manière.
Ce que tu demandes, au demeurant éloigné de la vocation de Excel, ne serait possible qu'en sachant comment Microsoft à décidé de "découper". En connaissant donc le code ou l'algorithme exact choisi par l'équipe Microsoft concernée. Je ne connais personnellement pas cet algorithme et doute assez que Microsoft le communique à la demande

[jonathan.chaf]

merci pour ta réponse. Ca m'a fait pensé du coup a une nouvelle solution mais qui ne donne pas de super résultat mais on s'approche.


voici le code :

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
Private Sub CommandButton1_Click()
Dim X As Integer
Dim Lettre As String
Dim Texte As String
Dim Texte1L As String
Dim Ligne As Integer
 
Ligne = 1
For X = 1 To Len(Me.TextBox1.Text)
    Lettre = Mid(Me.TextBox1, X, 1)
        If Lettre <> Chr(10) Then
            Texte1L = Texte 'valeur a garder pour la copie
            Texte = Texte & Lettre 'valeur a incrementer pour contrôle multiligne
            Me.TextBox2 = Texte
            TextBox2.SetFocus 'regarde si la textebox2 passe a la ligne
                 If Me.TextBox2.LineCount = 2 Then
                Range("A" & Ligne) = Texte 'copie le texte dans les cellules
                 Ligne = Ligne + 1
                Texte = ""  'vide le texte pour la nouvelle ligne
                Me.TextBox2 = ""
                End If
        End If
Next X
 
Range("A" & Ligne) = Texte 'ecrit la derniere ligne

Le problème c'est qu'il me coupe les mots en deux, je pourait peux être me débrouiller en allant chercher l'espace d’après ou d'avant.

Mais je me demande si il est possible de demander de copier seulement la 1ere ligne de la textbox vu qu'il peut les compter il y a une toute petit chanse qu'il puisse voir le texte de la 1ere ligne puis la seconde, ect.

En gros il me faudrait le code qui dise un truc du style :
texte = me.textbox.text.Line(1)


ou arriver a selectionner le texte de la X ligne de la texte box pour la copier coller.

[patricktoulon]

Bonjour

cette fonction est sensée te renvoyer un tableau de ligne ,ces lignes seront exactement les memes que dans la cellule

les subs de tests
dans la premiere sub les saut de ligne fictif dans la cellule sont reels dans la variable "texte":

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub texte_avec_vrai_saut_de_ligne ()
    Set cel = [A1]    '
    texte=Join(lignes(cel), vbCrLf)
   msgbox texte
End Sub

il ne reste plus qu'a choisir la ligne que tu veux dans "recupe_la_ligneX"
n'oublie pas ca te renvoie un variable tableau en base 0 donc la ligne 1du texte c'est ligne du tableau(0) la 2 c'est la 1 etc.... '

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub recupe_la_ligneX()
    MsgBox "3eme ligne =" & lignes([A1])(2)  'devrait donner la meme ligne que la ligne 3 dans la cellule
End Sub

La fonction:

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
Function lignes(cel)
    Dim T, i#
    Set T = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, Left:=1, Top:=1, Width:=cel.Width, Height:=cel.Height)
    With T
        .Name = "wrapp"
        .Activate
        .Object.Value = cel.Value: .Object.AutoSize = False: .Object.MultiLine = True: .Object.WordWrap = True
        .Object.SelectionMargin = False: .Object.Font.Size = cel.Font.Size: .Object.Font.Name = cel.Font.Name: .Object.Font.Bold = cel.Font.Bold
        .Object.Font.Italic = cel.Font.Italic
        For i = .Object.LineCount - 1 To 1 Step -1
            .Object.CurLine = .Object.LineCount - i
            .Object.SelText = vbCrLf
        Next
        lignes = Split(Replace(.Object.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
    End With
    ActiveSheet.OLEObjects("wrapp").Delete
End Function