Discussion :

[chevrotine56]

Bonjour à tous,

Ci joint un extrait du tableau sur lequel je travail.
Je ne peux pas en changer la forme.

Dans la colonne "Historique", je voudrais pouvoir compter le nombre de lignes dans chaque cellules.
Les cellules sont remplient via un UserForme, il y a des retour a la ligne volontaire (chr10) et des retour a la ligne automatique.
le but c'est de compter le nombre de lignes et de redimenssioner la hauteur des cellules en fonction du nombre de lignes
J'ai essayé avec la fonction AutoFit mais ca ne fonctionne pas.

Merci de votre aide
Pièce jointe 397965

[Menhir]

Dans la colonne "Historique", je voudrais pouvoir compter le nombre de lignes dans chaque cellules.
Les cellules sont remplient via un UserForme, il y a des retour a la ligne volontaire (chr10) et des retour a la ligne automatique.

Je peux me tromper mais je pense que c'est impossible.
On peut, à la rigueur, compter le nombre de code 10 dans la cellules, mais le nombre de retour automatiques, c'est complètement invisible.

A moins d'avoir utiliser une police de caractère à pas constant et de savoir combien de caractère par ligne donne la largeur de la cellule.
Mais même ainsi, ça ne me semble pas vraiment fiable.

[chevrotine56]

Ok, et pour compter le nombre de code 10 je fais comment?

[Menhir]

Cette fonction te donnera le nombre de lignes en fonction du nombre de retour forcés.

Code :

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

1
2
3
4
5
6
7
Function LIGNESIN(ByRef Loc) As Long
    Dim i As Long
    LIGNESIN = 1
    For i = 1 To Len(Loc.Value)
        If Mid(Loc, i, 1) = Chr(10) Then LIGNESIN = LIGNESIN + 1
    Next i
End Function

[chevrotine56]

j'ai reussi,
J'ai un peux modifié le code ca donne ç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
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
Public Sub Mise_en_forme()
Dim derlig As Integer
Dim I As Integer
Dim LIGNESIN As Integer
Dim a As Long
Dim Loc As Range
Dim L As Long
 
derlig = Cells(Rows.Count, 1).End(xlUp).Row
derlig =derlig  + 1
 
For I = derlig To 6 Step -2
    LIGNESIN = 0
        Set Loc = Cells(I - 1, "AF")
        L = 0
            For a = 1 To Len(Loc)
                L = L + 1
                If Mid(Loc, a, 1) = Chr(10) Then
                    LIGNESIN = LIGNESIN + 1
                    L = 0
                End If
                If L = 45 Then
                   LIGNESIN = LIGNESIN + 1
                   L = 0
                End If
            Next a
        If LIGNESIN >= 3 Then
            LIGNESIN = LIGNESIN - 1
            Range(Rows(I), Rows(I - 1)).RowHeight = Range(Rows(I), Rows(I - 1)).RowHeight + (LIGNESIN * 11)
        End If
    Next I
End Sub

Merci de ton aide @Menhir

[Qwazerty]

Salut

La méthode autofit de la ligne ne donne pas un résultat convenable?

++
Qwaz

[Menhir]

J'ai essayé avec la fonction AutoFit mais ca ne fonctionne pas.

Encore faut-il savoir comment tu l'as utilisée...
Avant de condamner l'outil, regardons la main qui le manie.

[Qwazerty]

C'est bon j'ai compris, vive les cellules fusionnées....
Bon courage!


[Edit]
Sinon copier le contenu de la cellule dans une feuille masquée en lui donnant la même largeur que la cellule source, puis en faisant un autofit et en relevant la hauteur ainsi obtenue.
[/Edit]

++
Qwaz

[patricktoulon]

bonjour
il existe une astuce pour compter OU!! determiner le texte de chaque ligne dans une cellule
et cela avec des saut de lignes volontaires (vbcrlf,chr(10),chr(13),vblf,etc...) ou par l'auto ajustement de la cellule
pour cela on utilise un textbox au dimention et propriété font identique a la cellule
en se servant des propriété (linecount,curline,seltext) on peut creer un tableau de lignes

demo

Code :

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

1
2
3
4
5
6
7
8
Sub testligne3()
 
    lignes = compteligne([A3])
 
    MsgBox "il y a " & UBound(lignes) & " lignes dans la cellule"
 
    MsgBox "la ligne 1 c'est :" & lignes(1)     'devrait donner la meme ligne que la ligne 1 dans la cellule
End Sub

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
Function compteligne(cel)
    Dim T As Object, 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 = vbCrLf & 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
        compteligne = Split(Replace(.Object.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
    End With
    ActiveSheet.OLEObjects("wrapp").Delete
End Function