Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

rodger85

XLDnaute Nouveau
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é
VB:
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
 

patricktoulon

XLDnaute Barbatruc
Bonjour @mapomme
perso pour moi la grosse artillerie c'est ce genre de truc
VB:
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

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

rodger85

XLDnaute Nouveau
é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
VB:
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

XLDnaute Barbatruc
et en fouillant bien mes vieux trucs et là je suis allé loin dans mes archives
VB:
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

XLDnaute Barbatruc
re
et une autre avec StdPicture
Code:
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 "
 

rodger85

XLDnaute Nouveau
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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…