Discussion :

[goninph]

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 :

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
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

[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

[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

[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 :

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

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

[goninph]

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

Meilleures salutations
Philippe

[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 :

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

NbLig = TextBox1.LineCount

Cdlt

[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 :

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

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

ou

Code :

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

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

[goninph]

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 :

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
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

[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

[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.

[Pierre Fauconnier]

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

[...]

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[...]

[...]
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[...]

[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.

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.

[goninph]

Hello,
Pourriez-vous m'en dire plus sur

[...]
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

[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

[patricktoulon]

bonjour
a approfondir
exemple

Code :

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

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