Discussion :

[seriousmath]

Bonjour,

J'ai lu cette discussion.

Je vais surtout m'adresser à patricktoulon mais toutes les aides seront bien entendues les bienvenues.

J'ai parcouru plusieurs forum et j'ai fais des tests sur mon fichier mais impossible de respecter le ratio de l'image intégrée à mon commentaire.

La macro est associée aux cellules de la colonne R de ma feuille, lorsque je tape un numéro dans la cellule, elle vérifie si une image existe dans un dossier spécifique et si oui, elle la joint en commentaire à la cellule.

Tout fonctionne bien sauf que le ratio n'est pas respecté, je triche avec la variable ech, serait il possible de régler ce problème ?

Et je pousse plus loin ma demande... Ma macro ne fonctionne qu'avec une nouvelle saisie, est il possible d’intégrer un contrôle dans la macro pour qu'elle vérifie toutes les cellules déjà remplies ?

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
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 18 And Target.Count = 1 Then
    répertoirePhoto = "D:\Users\Mathieu\Desktop\Excel\Christophe\images\" ' adapter
     ech = 2
    Target.ClearComments
    nf = répertoirePhoto & Target & ".jpg"
    If Dir(nf) <> "" Then
Target.AddComment
Target.Comment.Text Text:=CStr(Target.Value)
Target.Comment.Visible = True
Target.Comment.Shape.Fill.UserPicture nf
Set myShell = CreateObject("Shell.Application")
Set myFolder = myShell.Namespace(répertoirePhoto)
Set myFile = myFolder.Items.Item(Target & ".jpg")
Taille = myFolder.GetDetailsOf(myFile, 26)
Target.Comment.Shape.Height = 135
Target.Comment.Shape.Width = 170
Target.Comment.Shape.ScaleHeight ech, msoFalse, msoScaleFromTopRight
Target.Comment.Shape.ScaleWidth ech, msoFalse, msoScaleFromTopRight
Target.Comment.Visible = False
     End If
   End If
End Sub

un énorme merci pour vos lectures et coup de pouce

[patricktoulon]

bonjour

j'avais donné une astuce pour mettre le commentaire au ration de l'image et bien sur sans passer par l'object scripting runtime tout simplement avec ipicturedisp

si ca n'est pas cela que tu veux il faut donner plus de precision

c'est vrai que c'eszt un sujet qui date mais bon allons y !!!

re
Adapte le dossier et lea largeur max que tu veux ne touche rien d'autre

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pict As IPictureDisp, leheight As Long, maxlarge As Long, lewidth As Long
    maxlarge = 100    'largeur maximum  adapter a ton souhait
    répertoirePhoto = "C:\Users\Public\Pictures\Sample Pictures\"    ' adapter a ton dossier
    If Target.Column = 1 And Target.Count = 1 Then
        nf = répertoirePhoto & Target
        If Dir(nf) <> "" Then
            Set pict = LoadPicture(répertoirePhoto & Target.Value)
            multiple = (Round(pict.Width / 1280.38752362949)) / (Round(pict.Height / 1280.38752362949))
            Debug.Print multiple
            Target.ClearComments
            Target.AddComment
            Target.Comment.Text Text:=Target.Value
            With Target.Comment.Shape
                .Width = maxlarge    'facultatif!!! on atribue une largeur maxi pour le commentaire si ligne bloquée width de commentaire  par defaut
                .Height = .Width / multiple    'pour son height on applique le multipliquateur obtenu avec le ratio de l'image
                .Fill.UserPicture répertoirePhoto & Target     'on rempli le commentaire avec  l'image
            End With
        End If
    End If
End Sub

[seriousmath]

en fait je ne connais pas VBA, je suis assez débrouillard pour récupérer du code par ci par la et faire quelques copier/coller....

Au final ce que je voudrais c'est modifier ma macro pour quelle affiche l'image dans son ratio initiale, 4/3, 16/9 ou n'importe quoi d'autre

J'ai essayé de bidouiller ce morceau de mon code car je me dis que c'est ici que la taille du commentaire est definie mais au final suivant l'aspect d'origine c'est pas bon.

Code :

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

1
2
3
 
Target.Comment.Shape.Height = 135
Target.Comment.Shape.Width = 170

Bref desole je suis vraiment noob en vba mais j'essaie, si vous ne comprenez pas ma demande ou si elle n'est pas realisable c'est pas grave.

Merci

[EDIT] je viens de voir ton message, on rédigeait en même temps. Je test ton code et fais suivre...

[patricktoulon]

ps:
modifie la colonne moi j'ai utlisé la 1

re

purré essaie le mien et c'est tout!

[seriousmath]

Avec mon code pour n'importe quelle cellule de la colonne R j'ai bien le commentaire et l'image qui s'affiche au mauvais ratio.

J'ai collé ton code à la place du miens, modifié le chemin d'accès des images, modifié la colonne vers R donc 18 mais ça ne fonctionne pas.
Quand je saisi la valeur dans ma cellule et que je valide avec entrée il ne se passe rien. Je passe à la cellule suivante et pas de commentaire...

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pict As IPictureDisp, leheight As Long, maxlarge As Long, lewidth As Long
    maxlarge = 150    'largeur maximum  adapter a ton souhait
    répertoirePhoto = "D:\Users\Mathieu\Desktop\Excel\Christophe\images\"    ' adapter a ton dossier
    If Target.Column = 18 And Target.Count = 1 Then
   nf = répertoirePhoto & Target
        If Dir(nf) <> "" Then
            Set pict = LoadPicture(répertoirePhoto & Target.Value)
            multiple = (Round(pict.Width / 1280.38752362949)) / (Round(pict.Height / 1280.38752362949))
            Debug.Print multiple
            Target.ClearComments
            Target.AddComment
            Target.Comment.Text Text:=Target.Value
            With Target.Comment.Shape
                .Width = maxlarge    'facultatif!!! on atribue une largeur maxi pour le commentaire si ligne bloquée width de commentaire  par defaut
                .Height = .Width / multiple    'pour son height on applique le multipliquateur obtenu avec le ratio de l'image
                .Fill.UserPicture répertoirePhoto & Target     'on rempli le commentaire avec  l'image
            End With
        End If
    End If
End Sub

désolé de t'importuner
merci

[patricktoulon]

il ne se passe rien ???

a tu bien mis ce code la ou il faut au moins c'est dans le module de la feuille concernée qu'il faut le mettre

LOL

a oui autant pour moi toi tu ajoute l'extention moi je les ai deja dans les cellules alors pour toi se sera

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
    Dim pict As IPictureDisp, leheight As Long, maxlarge As Long, lewidth As Long
    maxlarge = 150    'largeur maximum  adapter a ton souhait
    répertoirePhoto = "D:\Users\Mathieu\Desktop\Excel\Christophe\images\"    ' adapter a ton dossier
    If Target.Column = 18 And Target.Count = 1 Then
   nf = répertoirePhoto & Target &".jpg"    
          If Dir(nf) <> "" Then
            Set pict = LoadPicture(nf)
            multiple = (Round(pict.Width / 1280.38752362949)) / (Round(pict.Height / 1280.38752362949))
            Debug.Print multiple
            Target.ClearComments
            Target.AddComment
            Target.Comment.Text Text:=Target.Value
            With Target.Comment.Shape
                .Width = maxlarge    'facultatif!!! on atribue une largeur maxi pour le commentaire si ligne bloquée width de commentaire  par defaut
                .Height = .Width / multiple    'pour son height on applique le multipliquateur obtenu avec le ratio de l'image
                .Fill.UserPicture nf     'on rempli le commentaire avec  l'image
            End With
        End If
    End If
End Sub

[seriousmath]

je viens de coller le nouveau code dans la feuille et erreur d'execution 1004 sur cette ligne.

Code :

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

Target.Comment.Text Text:=Target.Value

[EDIT] comme ceci ça fonctionne

Code :

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

Target.Comment.Text Text:=Target.Value & ".jpg"

par contre maintenant, quand je fais SUPPR dans une cellule, ca ne me supprime plus automatiquement le commentaire.

[EDIT2] En rajoutant

Code :

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

 Target.ClearComments

juste apres

Code :

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

    répertoirePhoto = "D:\Users\Mathieu\Desktop\Excel\Christophe\images\"

si je clique suppr toute la case se vide (valeur + commentaire)

Super je touche au but !!!

Dernière demande, la macro peut elle reprendre les valeurs déjà présentes dans la cellule pour créer le commentaire ?
Si par exemple je viens de recevoir la photo de mon nouveau projet, que je n'ai pas a retaper son numéro pour que ca photo apparaisse en commentaire.

Vous me suivez ?

Déjà un énorme merci !!!