Compter le nombre de retours à la ligne dans une textbox

Version imprimable

Bonjour,

Super merci pour toutes les infos.

Encore une question, comment compter le nombre de retour à la ligne dans le textbox ?

Ainsi je pourrai renseigner ma variable Nbre_de_retour_ligne actuellemnet à 5.

Merci et bonne soirée
Philippe

Code:

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
34
35
36
37
38
39
40
41
42
43
Sub Inserer_photo_travaux()
    Dim Position As Range
    Dim Img As Object
    Dim ShapeObj As Shape
    Dim Image As Object
    Dim Largeur_Image_Originale As Variant
    Dim Hauteur_Image_Originale As Variant
    Dim Ratio_Image_Originale As Variant
    Dim Largeur_Image_Excel As Variant
    Dim Hauteur_Image_Excel As Variant
    Dim Nbre_de_retour_ligne As Variant
    Dim Hauteur_texte As Variant
'Supprimer la photo existante
        For Each Image In ActiveSheet.Shapes
            If Not Intersect(Image.TopLeftCell, ActiveCell) Is Nothing Then Image.Delete
        Next Image
'Attacher la nouvelle photo
    If Application.Dialogs(xlDialogInsertPicture).Show Then     'Ouvrir l'explorateur de fichier
    Set Position = ActiveCell                                'Définit l'emplacement de l'image
    Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        Largeur_Image_Originale = Img.Width
        Hauteur_Image_Originale = Img.Height
        Ratio_Image_Originale = Largeur_Image_Originale / Hauteur_Image_Originale
        Largeur_Image_Excel = 250
        Hauteur_Image_Excel = Largeur_Image_Excel / Ratio_Image_Originale
        Nbre_de_retour_ligne = 5
        Hauteur_texte = Nbre_de_retour_ligne * 15 '15 = Hauteur de cellule pour une ligne
    With Img.ShapeRange
        .LockAspectRatio = msoTrue          'Conserver le ratio de la photo
        .Width = Largeur_Image_Excel        'Largeur de l'image
        .Top = Position.Top + Hauteur_texte 'Si pas de chiffre = l'image sera aux mêmes dimensions que la cellule
        .Left = Position.Left + 8           'Si pas de chiffre = l'image sera aux mêmes dimensions que la cellule
    End With
        With ActiveCell
        .RowHeight = Hauteur_Image_Excel + Hauteur_texte
    End With
        Img.Placement = xlMoveAndSize    'Déplacer et dimensionner avec les cellules
        'IMPORTANT Ne pas sélectionner une autre cellule pour la suite de la macro
    Else
        MsgBox _
            "L'image n'a pas été remplacée.", vbInformation, "! Oups ! Action interrompue"
    End If
End Sub

17/08/2019, 06h21
ARTURO83

Bonjour,

Encore une question, comment compter le nombre de retour à la ligne dans le textbox ?
Ainsi je pourrai renseigner ma variable Nbre_de_retour_ligne actuellemnet à 5.

Quelle Textbox? Quel contenu? etc... Précisez

Cdlt
17/08/2019, 08h13
goninph

Hello,
La textbox qui est utilisée pour ajouter du texte à la cellule active, voir image dans un des poste précédent.
En fait je peux ajouter du texte et ou une image à la cellule active. Lorsque j'écris du texte, j'aimerais pouvoir compter les retours à la ligne pour ajouter l'espace nécessaire en dessus de l'image.

Meilleures salutations
Philippe
17/08/2019, 08h42
ARTURO83
Compter le nombre de retour ligne dans une textbox, je ne sais pas si c'est possible, par contre je vous propose une solution de contournement.
Dans les propriétés de la textbox, mettez:
Code:

1 2 MultiLine=True MaxLengh=100 (pour 100 caractères avant le renvoi à la ligne, ou la valeur de votre choix)
pour déterminer le nombre de renvoi, prendre l'arrondi.sup(nombre de caractères de la textbox / valeur de MaxLengh)

Essayez

Cdlt
17/08/2019, 17h50
goninph

Merci, Mais MaxLengh=100 empêche la saisie de 101 caractères

Meilleures salutations
Philippe
18/08/2019, 06h49
ARTURO83

Bonjour,

Effectivement je me suis trompé, remettez MaxLength = 0
Mettez EnterFieldBehavior=1-fmEnterFieldBehaviorRecallSelection
puis dans votre code, pour compter le nombre de ligne de la textbox:

Code:

NbLig = TextBox1.LineCount

Cdlt
18/08/2019, 08h55
Philippe Tulliez
Bonjour,
Une autre solution est de calculer la différence entre le nombre de caractères du TextBox et le nombre de caractères amputé des retours à la ligne (vbCrLf)
Deux façons de le calculer
Code:

1 2 3 With Me.TextBox1 MsgBox 1 + ((Len(.Value) - Len(Replace(.Value, vbCrLf, ""))) / 2) End With
ou
Code:

1 2 3 With Me.TextBox1 MsgBox UBound(Split(.Value, vbCrLf)) + 1 End With

1 pièce(s) jointe(s)

bonjour
il y a beaucoup plus simple pour compter le nombre de ligne d'un textbox qu'elle soientt réelles ou provoquées par le wraptext
curline ca vous parle?
un petit exemple
dans cet exemple il y a seulement 2 vbcrlf les autres sauts sont généré par le wraptext

testé dans un UserForm avec un textbox multiline et un bouton
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub testligne() texte = TextBox1.Text TextBox1.SetFocus For i = TextBox1.LineCount - 1 To 1 Step -1 TextBox1.CurLine = TextBox1.LineCount - i TextBox1.SelText = vbCrLf ' en bloquant cette ligne on a le vrai nombre de saut de ligne Next lignes = Split(Replace(TextBox1.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf) MsgBox UBound(lignes) + 1 TextBox1.Text = texte End Sub ' Private Sub CommandButton1_Click() testligne End Sub
Pièce jointe 498131
vous pouvez exploiter la variable tableau (lignes)qui contient les lignes tel que dans le textbox

du reste pour avoir essayé le len par rapport au width etc.... avant de connaitre cette solution ,ca n'a jamais été précis et de même pour une cellule multiline

18/08/2019, 19h11
goninph

Excellent, topissime, la grande classe.

Merci et merci
Meilleures salutations
Philippe

Hello,

Enfin tout fonctionne ou presque :
Lorsque j'ajoute une photo est du texte en même temps via le bouton attaché une image tout est impeccable.
Mais lorsque j'ajoute ou efface du texte en dessus de la photo, la largeur de la photo ne change pas ce qui est correcte, la photo monte ou descend dans la cellule ce qui parfait, par contre la hauteur de la photo augment ou diminue sensiblement à chaque ligne en plus ou en moins.

Le Userform s'ouvre au clic sur la cellule et tout se déroule via le Userform aucune action par l’utilisateur n'est possible en direct dans les cellules de cet onglet.

Qu'est-ce que j'ai fait comme bourde ?

Merci pour votre aide
Meilleures salutations
Philippe

Code:

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub Inserer_photo_travaux()
    Dim Emplacement As Range
    Dim Img As Object
    Dim Image As Object
    Dim Largeur_cellule As Variant
'    Dim Marge_Image_cellule_gauche_droite As Variant
'Supprimer la photo existante
        For Each Image In ActiveSheet.Shapes
            If Not Intersect(Image.TopLeftCell, ActiveCell) Is Nothing Then Image.Delete
        Next Image
'Attacher la nouvelle photo
    If Application.Dialogs(xlDialogInsertPicture).Show Then     'Ouvrir l'explorateur de fichier
    Set Emplacement = ActiveCell                                'Définit l'emplacement de l'image
    Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
'Hauteur de la ligne avec ou sans photo
        Images_photos.Hauteur_de_ligne_avec_photo
'Position et dimensionnement de la photo
    With Img.ShapeRange
        .LockAspectRatio = msoTrue          'Conserver le ratio de la photo
        .Width = Largeur_Image_Excel_photo_travaux        'Largeur de l'image
        .Top = Emplacement.Top + Hauteur_texte_photo_travaux + 5 '+5 = marge du haut
        .Left = Emplacement.Left + Marge_Image_colonne_photo_travaux / 2
    End With
        Img.Placement = xlMoveAndSize    'Déplacer et dimensionner avec les cellules
'IMPORTANT Ne pas sélectionner une autre cellule pour la suite de la macro
    Unload USF_Modifier_texte_PV
    Else
        MsgBox _
            "L'image n'a pas été remplacée.", vbInformation, "! Oups ! Action interrompue"
    End If
End Sub
Sub Hauteur_de_ligne_avec_photo()   'Cette macro est appelée par Inserer_photo_travaux et le bouton OK USF_Modifier_texte_PV
' Variable public au sommet de la page : Hauteur_texte - Largeur_Image_Excel - Hauteur_Image_Excel - Marge_Image_cellule_gauche_droite
    Dim Texte As Variant
    Dim I As Variant
    Dim lignes As Variant
    Dim Nbre_de_retour_ligne As Variant
    Dim Img As Object
    Dim ShapeObj As Shape
    Dim Image As Object
    Dim Largeur_Image_Originale As Variant
    Dim Hauteur_Image_Originale As Variant
    Dim Ratio_Image_Originale As Variant
    Dim Largeur_cellule As Variant
    Dim Emplacement As Range
'Début du calcul de la hauteur du texte à laisser en dessus de l'image pour le texte
    Texte = USF_Modifier_texte_PV.TextBoxPVchantier.Text
    USF_Modifier_texte_PV.TextBoxPVchantier.SetFocus
    For I = USF_Modifier_texte_PV.TextBoxPVchantier.LineCount - 1 To 1 Step -1
        USF_Modifier_texte_PV.TextBoxPVchantier.CurLine = USF_Modifier_texte_PV.TextBoxPVchantier.LineCount - I
        USF_Modifier_texte_PV.TextBoxPVchantier.SelText = vbCrLf    ' en bloquant cette ligne on a le vrai nombre de saut de ligne
    Next
        lignes = Split(Replace(USF_Modifier_texte_PV.TextBoxPVchantier.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
        Nbre_de_retour_ligne = UBound(lignes) + 1
        USF_Modifier_texte_PV.TextBoxPVchantier.Text = Texte    'Remplace le texte original après la boucle de comptage
    Hauteur_texte_photo_travaux = Nbre_de_retour_ligne * 15 '15 = Hauteur de cellule pour une ligne de texte
'Fin du calcul de la hauteur du texte à laisser en dessus de l'image pour le texte
'Début du calcul de la hauteur de la photo
    Marge_Image_colonne_photo_travaux = 10
    Set Emplacement = ActiveCell
    Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With Img.ShapeRange
            Largeur_cellule = ActiveCell.ColumnWidth    'Largeur de la colonne
            Largeur_Image_Excel_photo_travaux = (Largeur_cellule * 5.35) - Marge_Image_colonne_photo_travaux '5.35 = ratio entre largeur image et largeur cellule excel
            Largeur_Image_Originale = Img.Width
            Hauteur_Image_Originale = Img.Height
            Ratio_Image_Originale = Largeur_Image_Originale / Hauteur_Image_Originale
            Hauteur_Image_Excel_photo_travaux = Largeur_Image_Excel_photo_travaux / Ratio_Image_Originale
        End With
            Img.ShapeRange.Top = Emplacement.Top + Hauteur_texte_photo_travaux
'Fin du calcul de la hauteur de la photo
On Error GoTo Hauteur_ligne_trop_grande
                    With ActiveCell
                        .RowHeight = Hauteur_texte_photo_travaux + Hauteur_Image_Excel_photo_travaux + 10 'Hauteur de la ligne
                    End With
Exit Sub
Hauteur_ligne_trop_grande:
MsgBox _
        vbCrLf & _
        "La hauteur maximum de la ligne est atteinte." & vbCrLf & vbCrLf & _
        vbCrLf & _
        "Réduire la hauteur du texte ou de la photo." & vbCrLf & vbCrLf & _
        "- Erreur VBA : " & vbCrLf & Err.Description & vbCrLf & vbCrLf & _
        "", vbExclamation, "! Oups ! Action interrompue"
End Sub
Sub Supprimer_photo_travaux()
    Dim Image As Object
    If MsgBox("Supprimer la photo ?", vbYesNo + vbQuestion, "Editer le PV") = vbYes Then
        For Each Image In ActiveSheet.Shapes
            If Not Intersect(Image.TopLeftCell, ActiveCell) Is Nothing Then Image.Delete
        Next Image
            ActiveCell.EntireRow.AutoFit
        Unload USF_Modifier_texte_PV
    End If
End Sub

19/08/2019, 02h26
goninph

Hello,

En fait ça ne fonctionne pas si bien que cela, des images disparaissent bref, usine à gaz.

Comment détecter si une image est présente dans la cellule et limiter la saisie de plus de 2 lignes dans le Textbox avec ou sans retour à la ligne et si pas d'image saisie libre ?

Merci pour tout et bonne nuit
Philippe
19/08/2019, 03h22
clementmarcotte

Bonjour,

Ce que j'en dis, c'est qu'Excel n'est pas fait pour cela. D'autant plus qu'il existe au moins un logiciel de gestion de projet qui est gratuit. Je ne sais pas s'il peut inclure des images.

Et si tu veux absolument te coller à Excel, tu peux faire un "publipostage" de ton rapport dans Word. Et il y a moyen d'y mettre des images.

Et tu peux le faire dans Access, à la condition de pas stocker tes images dans ta base Access. Mais, tu peux stocker les chemins d'accès.

Et je te redis que tu peux mettre des contrôles Image (quand même pas des millions) dans ta feuille de calcul.
19/08/2019, 09h03
goninph

Hello,
Pourriez-vous m'en dire plus sur

Citation:

Envoyé par clementmarcotte

[...]
Et je te redis que tu peux mettre des contrôles Image (quand même pas des millions) dans ta feuille de calcul.

Ça ressemble à quoi ? Est-ce plus léger ? Quelles sont les avantages ?

Merci et meilleures salutations
Philippe
19/08/2019, 15h10
Pierre Fauconnier

Perso, si j'étais toi, je retiendrais surtout les deux choses suivantes dans ce qu'a dit Clément

Citation:

Envoyé par clementmarcotte

[...]

Ce que j'en dis, c'est qu'Excel n'est pas fait pour cela. D'autant plus qu'il existe au moins un logiciel de gestion de projet qui est gratuit[...]

Citation:

Envoyé par clementmarcotte

[...]
Et si tu veux absolument te coller à Excel, tu peux faire un "publipostage" de ton rapport dans Word. Et il y a moyen d'y mettre des images[...]
20/08/2019, 21h49
clementmarcotte

En tout cas, il y en a qui vont être morts de rire quand cela va être le temps d'imprimer la feuille "parfaite" qui va être à l'écran. Parce que le truc qui va permettre de faire correspondre exactement et facilement 1 centimètre à l'écran avec exactement 1 centimètre sur papier n'a probablement pas encore été trouvé. Et ce n'est même pas certain qu'une image de 1 cm de longueur et un texte de 1 cm de longueur vont avoir tous deux la même dimension imprimée.

Il y a tellement de facteurs en jeu que même arriver à une situation parfaite sur un couple donné écran-imprimante ne peut pas garantir que cela va être la même chose avec un autre couple. Et, on a même pas encore parlé d'avoir la même page parfaite, en même temps pour un écran de 15 pouces, un écran de 17 pouces et un écran de 19 ou de 21 pouces.

Bonjour.

Citation:

Envoyé par goninph

Hello,
Pourriez-vous m'en dire plus sur

Ça ressemble à quoi ? Est-ce plus léger ? Quelles sont les avantages ?

Merci et meilleures salutations
Philippe

Ça, c'était avant que ne pense à l'impression. Parce que l'impression c'est loin d'être le point fort d'Excel.

Quant à moi, si on s'en tient juste à la suite MS Office, Les applications qui se tirent le mieux d'affaire dans le domaine de l'impression combinée de textes et d'images sont Publisher et dans une moindre mesure Word. Pour Project et Visio, je ne sais pas. Pour les autres applications, l'impression c'est plus un bonus ou un service complémentaire.

Et, personnellement, j'ai un énorme doute sur la possibilité de réaliser ton chef d'œuvre avec une seule application Office, quelle qu'elle soit. Du moins pas avec Office. Parce que Microsoft a conçu Office comme un groupe d'applications spécialisées qui travaillent ensemble et pas comme un groupe d'applications généralistes capables de tout faire seules.
20/08/2019, 22h31
goninph

Entiérement d'accord.

Mais comment détecter si une image est présente dans la cellule pour limiter la saisie à 2 lignes dans le Textbox avec ou sans retour à la ligne et si pas d'image saisie libre ?

Merci pour tout et bonne nuit
Philippe

bonjour
a approfondir
exemple

Code:

1
2
3
4
5
6
7
8
9
Sub test()
MsgBox detectimage ([C3])
End Sub
'
Function detectimage(rng)
For Each pict In ActiveSheet.Pictures
If pict.TopLeftCell.Address = rng.Address Then detectimage = pict.Name
Next
End Function