XL 2016 commentaire doit s'adapter à une image importé

[rodger85]

Bonjour
je sais importer une image pour l'incorporer dans un commentaire mais le problème c'est l'image qui s'adapte au commentaire et pas l'inverse voici le code utilisé

With ActiveCell
.ClearComments
.AddComment
.Comment.Shape.Fill.UserPicture nf 'nf = Application.GetOpenFilename("Fichier jpg, *.*")
'---------------------------
' ce qui permet de donner une dimension au commentaire
' mais je voudrais que le commentaire s'adapte à la taille de l'image importé automatiquement
' et si j'enleve les 2 lignes du dessou je me retrouve avec un petit commentaire
 .Comment.Shape.Height = 450
 .Comment.Shape.Width = 635 ' = 22,41 cm
 '-----------------------------------
     .Comment.Shape.IncrementTop 24
     .Comment.Shape.Left = 300 '397
     .Comment.Visible = True
     .Comment.Shape.ZOrder msoBringToFront
     End With

Merci d'avance

 

[mapomme]

Bonjour @rodger85 ,

Avec de la grosse artillerie, voir le fichier joint.

 

[patricktoulon]

Bonjour @mapomme
perso pour moi la grosse artillerie c'est ce genre de truc

Sub test()
    Dim nf, x, dimention_image
    nf = Application.GetOpenFilename("Fichier jpg, *.*")
    If nf = False Then Exit Sub
    Dim Img As Object
    PtoPX = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    With CreateObject("WIA.ImageFile")
    .LoadFile nf
        dimention_image = Array(.Width / PtoPX, .Height / PtoPX) ' dimention en point
    End With
    With ActiveCell
        .ClearComments: .AddComment
        .Comment.Shape.Height = dimention_image(1): .Comment.Shape.Width = dimention_image(0)
        ActiveCell.Comment.Shape.Fill.UserPicture nf
    End With
End Sub

 

[rodger85]

Bonjour mapomme
effectivement cela marche
je vais l'adapter à ma macro mais ce que je me suis aperçu
c'est qu'il faut lui adapter un DPI correct entre 150 et 300
puisque la macro s’appuie sur le DPI utilisé (X et Y)
mais ce n'est pas un problème
mais pourquoi dite vous "grosse artillerie"
car c'est la macro la plus simple et la plus efficace
que j'ai vu dans toute mes recherches
je vous tiens au courant
rodger

 

[patricktoulon]

Bonjour
ma version s'appuie sur le DPI utilisé

 

[patricktoulon]

le commentaire fait exactement la dimension de l'image
pour le test j'ai insérer 2 fois la même image dans la feuille sans la dimentionner
et une fois avec ma macro pour le commentaire
résultat

 

[rodger85]

évidement il y a un truc qui cloche
mais cela est de ma faute
je n'avais pas envoyé la macro en entière
c'est le "Dim nf, x" qui bloque
parque j'ai déja un " Dim nf As Variant"
voici la macro en entière

Sheets("Song").Select
Dim Fichier As String
Dim Chem As String
Dim nf As Variant
Chem = Worksheets("DonnéeGT100").Range("A70").Value
ChDrive Chem
ChDir Chem
nf = Application.GetOpenFilename("Fichier jpg, *.*")
If nf = False Then Exit Sub
With ActiveCell

 .ClearComments
 .AddComment
 .Comment.Shape.Fill.UserPicture nf
 .Comment.Shape.Height = 450
 .Comment.Shape.Width = 635 ' = 22,41 cm
 .Comment.Shape.IncrementTop 24
 .Comment.Shape.Left = 300 '397
 .Comment.Visible = True
 .Comment.Shape.ZOrder msoBringToFront
     End With
   
     Application.ScreenUpdating = True

j'ai essayé diverses manieres de l'integrer mais je n'y arrive pas

 

[patricktoulon]

re
déjà là c'est toi qui dimensionne le comm et non a la dimension de l'image
après même comme ca le code est propre et semble fonctionnel
mais ca ne correspond pas à ta demande

 

[patricktoulon]

et en fouillant bien mes vieux trucs et là je suis allé loin dans mes archives

Sub testavecIPictureDisp()
    Dim nf, pict As IPictureDisp, W&, H&
    nf = Application.GetOpenFilename("Fichier jpg, *.*")
    If nf = False Then Exit Sub
    Dim Img As Object
    dpi = Val(CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"))
    ptopx = dpi / 72
    Set pict = LoadPicture(nf)
    With pict
        W = Round(.Width / 2540 * dpi) / ptopx
        H = Round(.Height / 2540 * dpi) / ptopx
    End With


    With ActiveCell
        .ClearComments: .AddComment
        .Comment.Shape.Height = H: .Comment.Shape.Width = W
        ActiveCell.Comment.Shape.Fill.UserPicture nf
    End With
End Sub

le result est le même

 

[patricktoulon]

re
et une autre avec StdPicture

Sub TestAvecStdPicture()
    Dim nf, pict As New StdPicture, W&, H&
    nf = Application.GetOpenFilename("Fichier jpg, *.*")
    If nf = False Then Exit Sub
    Dim Img As Object
    dpi = Val(CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI"))
    PtoPX = dpi / 72
    Set pict = LoadPicture(nf)
    With pict
        W = Round(.Width / 2540 * dpi) / PtoPX
        H = Round(.Height / 2540 * dpi) / PtoPX
    End With


    With ActiveCell
        .ClearComments: .AddComment
        .Comment.Shape.Height = H: .Comment.Shape.Width = W
        ActiveCell.Comment.Shape.Fill.UserPicture nf
    End With
End Sub

voilà tu a 3 façons de connaitre la dimension d'une image
c'est @mapomme qui disait toute à l'heure "sortir la grosse artillerie "

 

[mapomme]

Re,

Juste pour saluer @patricktoulon ,

Un fichier avec des images pour tester.

 

[patricktoulon]

re
je teste ça tout a l'heure je suis sur un autre truc là

 

[mapomme]

re
je teste ça tout a l'heure je suis sur un autre truc là

Rien à tester, c'est le même code que dans mon premier message.
Me too, je vais me mettre sur un autre truc : la sieste thérapeutique.

 

[patricktoulon]

re
oui ça fonctionne mais c'est pas l'artillerie lourde du moins pour moi

 

[rodger85]

merci à vous deux
maintenant cela marche
j'ai juste enlevé "Dim nf As Variant" de ma macro
comme ça j'ai pu insérer la votre (celle de mapomme)je garde les autres en réserve au cas ou.
deux semaines de recherche ,et voila des réponses efficace en peu de temps
Merci encore pour cette rapidité je pense que je reviendrai
car j'ai d'autres trucs qui sont un peu bizarre dans certaines de mes macros
rien de grave en soi ,mais il faut que je fasse un fichier qui marche seul
parque mes macros sont toutes imbriquées entre elles
Rodger85