Discussion :

[patricktoulon]

Bonjour a tous
pour un autre sujet Unparia m'a donné une astuce pour gérer le fontweight ou même le fontWidth

j'ai plus ou moins repris l'astuce pour en faire autre chose :un compteur de ligne

en effet c'est un sujet qui est apparu très souvent: comment détecter les sauts de lignes dans une cellules quand il n'y en a pas!!!

mais que la propriété (format cellule/ajuster a la ligne) est activée et donc le texte visuellement sur plusieurs lignes

j'ai donc créé une petite fonction que je viens vous montrer

elle a lair de fonctionner correctement au vues des tests que j'ai fait

cependant je me pose une question au sujet de ce + 9 que l'on trouve dans la fonction on peut aller jusqu'à +7
a quoi est il du ?au fait que le texte dans les cellules a une marge gauche tandis que le label en autosize non ?
ma 2d question c'est aurait il un moyen de simplifier le code bien qu'étant pas très volumineux c'est peu de le dire
voila 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
18
19
20
21
22
23
24
25
 
Function ligne(cel)
   If cel.Text <> "" Then
    Set Obj = ActiveSheet.OLEObjects.Add("Forms.Label.1")
    With Obj:
        .Object.Font.Size = cel.Font.Size:
        e = 1
        Do
         DoEvents
         i = i + 1
            .Object.AutoSize = False
            .Width = 1000:
            .Object.Caption = Mid(cel.Text, 1, i):
            .Object.AutoSize = True:
            a = a + Mid(cel.Text, i, 1)
            If .Width > (cel.Width - 9) * e Then a = a & vbCrLf: e = e + 1
        Loop Until i = Len(cel.Text)
          .Delete
    End With
    ligne = a
End If
End Function

et la sub de test

Code :

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

1
2
3
4
5
6
7
Sub test()
    Dim texte As String, cel As Range
    Set cel = ActiveSheet.[b2]
    texte = cel.Text
    ar = ligne(cel)
    MsgBox ar
End Sub

si vous avez une autre voie a proposer je prends aussi bien entendu
merci pour vos retours et participation d'avance

[Docmarti]

Bonjour Patrick.

Une facon KISS.

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
26
 Sub TestRetourALaLigne()
  Set c = Cells(2, 2)
 
  c.Value = "C'est une triste chose de penser que la nature parle et que le genre humain n'écoute pas." & vbLf & "Victor Hugo"
  c.WrapText = True
 
  MsgBox CalculerNbrLignes(c)
 
 End Sub
 Function CalculerNbrLignes(c)
 
  Set cel2 = Worksheets("Feuil2").Cells(1, 1)
 
  cel2.Parent.Rows("1").Clear
  cel2.ColumnWidth = c.ColumnWidth
 
  c.Copy cel2
 
  cel2.WrapText = c.WrapText
  h = cel2.RowHeight
 
  cel2.WrapText = False
 
  CalculerNbrLignes = h / cel2.RowHeight
 
 End Function

[patricktoulon]

Bonjour Docmarti
j'y avais pensé au rowheight en effet mais attention au formatage de la cellule si sa dimension avais été modifiée avant donc au pire utiliser la cells(rows.count,columns.count) pour le rapport
il y a moins de risque qu'elle ne soit pas d origine
cela dit ma question a été mal formulée j'en suis seul responsable

non seulement je veut le nombre de lignes mais je veux aussi le contenu ligne par ligne

je garde quand même ta façon KISS

a ma façon kissou

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
SSub TestRetourALaLigne()
    Set c = Cells(2, 2)
    c.Value = "C'est une triste chose de penser que la nature parle et que le genre humain n'écoute pas." & vbLf & "Victor Hugo"
    c.WrapText = True
    MsgBox CalculerNbrLignes(c)
End Sub
Function CalculerNbrLignes(c)
    Set cel2 = c.Parent.Cells(Rows.Count, Columns.Count)
    cel2.Clear
    cel2.ColumnWidth = c.ColumnWidth
    h = cel2.RowHeight
     cel2.Value = c.Value
    cel2.WrapText = c.WrapText
    CalculerNbrLignes = cel2.RowHeight / h
    cel2.Clear
End Function

par contre pour l'obtention de la valeur de chaque ligne c'est walouh le calcule donnerait faux
mais ca me donne une autre idée

[patricktoulon]

re
@docmarti je suis parti de ta version kiss
mais je n'arrive pas a mettre au point le passage des saut de ligne reel et chose étonnante avec le même width le texte d'une ligne peut être plus long

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
26
27
28
29
30
31
Sub TestRetourALaLigne()
    Set c = Cells(2, 2)
    c.Value = "C'est une triste chose de penser que la nature parle et que le genre humain n'écoute pas." & vbLf & "Victor Hugo"
    c.WrapText = True
    MsgBox UBound(CalculerNbrLignes(c))
End Sub
Function CalculerNbrLignes(c) As Variant
    ReDim tablo(30)
    tabl = Split(c.Value, " ")
    Set cel2 = Cells(4, 2)    ' 'c.Parent.Cells(Rows.Count, Columns.Count)
    cel2.Clear
    cel2.ColumnWidth = c.ColumnWidth
    cel2.WrapText = c.WrapText:
    h = cel2.RowHeight
    a = 0
    For i = 0 To UBound(tabl)
        If InStr(tabl(i), vbLf) > 0 Then tabl(i) = Replace(tabl(i), vbLf, ""): saut = True
        cel2.Value = cel2.Value & tabl(i) & " "
        If cel2.RowHeight = h Then
            tablo(a) = tablo(a) & tabl(i) & " "
        Else
            a = a + 1: tablo(a) = tabl(i) & " "
            h = cel2.RowHeight
        End If
        If saut = True Then a = a + 1: saut = False
    Next
ReDim Preserve tablo(0 To a)
    cel2.Clear
    cel2.Resize(UBound(tablo), 1) = Application.Transpose(tablo)
    CalculerNbrLignes = tablo
End Function

[Docmarti]

Attention. Le texte suivant

Code :

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

 c.Value = "C'est une triste chose de penser que la nature parle et que le genre humain n'écoute pas." & vbLf & "Victor Hugo"

contient un retour de ligne.
Il ne faut pas le supprimer car il fait partie du texte original.

[patricktoulon]

Attention. Le texte suivant

Code :

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

 c.Value = "C'est une triste chose de penser que la nature parle et que le genre humain n'écoute pas." & vbLf & "Victor Hugo"

contient un retour de ligne.
Il ne faut pas le supprimer car il fait partie du texte original.

oui docmarti la variable "saut" sert a traiter ce paramètre c'est justement la gestion de ce détail qui est le premier couic !
je pense pas le gérer correctement dans mon model
le 2d detail troublant c'est que un texte dans la cellule ajuster peut prendre une ligne et dans le résultat 2 avec le même columnwidth

[patricktoulon]

@Nicolas
bien venu dans mon nouveau motif de tourment cérébral
alors le but est de :

1. connaitre le nombre de ligne
2. connaitre la valeur de chaque ligne

une cellule ajustée a la ligne automatiquement par le menu (format cellule --->ajuster a la ligne automatiquement)affiche le texte sur plusieurs ligne ( c'est ce que l'on appelle le (wraptext)
tu constatera que si tu fait une recherche de saut de ligne par chr(10),chr(13),vbcrlf,vblf) tu n'en trouvera pas pourtant il y a bien plusieur lignes visuellement

donc le but avec le label en autosize c'est de l'alimenter jusqu'à quel théoriquement il atteigne la largeur de la cellule parti de la on a une ligne et on continue jusqu' au len(du texte)en mettant un repère a chaque fois que la (limite width * ligne déjà passée) est atteinte
ca fonctionne a peu près correctement

docmarti a apporter une idée en mémorisant le row height de départ et en le comparant au rowheight de l'arrivée en effet le compte est bon
seulement je voudrais avoir la valeur de chaque lignes

j'ai donc mijoté le code dans le post précédant mais c'est pas tout a fait au point
c'est une question que j'ai trouvé de nombreuses fois dans ce même forum et même ailleurs mais aucune vrai solution n'a pu être apporté a ce jour du moins je ne l'ai pas trouvé
alors haut les cœurs