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

XL 2019 Placer une image à une adresse précise du tableau

escouger

XLDnaute Occasionnel
Bonsoir,
Je suis en but à une difficulté lorsque je désire insérer une image à une adresse très précise de mon tableau excel.
Je me positionne sur une cellule (Range("d9").select par exemple), puis le fais l'insertion de mon image avec un Pictures.Insert. La photo ne se place pas exactement en D9.
J'aimerais que le coin supérieur gauche de ma photo se place dans le coin supérieur gauche de D9.

J'ai même essayé de faire un coupé après cette insertion , puis me repositionner en D9 puis un collé.
Cela ne marche pas mieux hélas.
Merci de me dire si cela est possible, et si oui comment faire.
 

Rouge

XLDnaute Impliqué
Bonjour,

Avec un bout de code VBA
VB:
Sub Placer_Image()
    With ActiveSheet.Shapes("Image 1")
        .Top = Range("D9").Top
        .Left = Range("D9").Left
    End With
End Sub

Remplacez "Image 1" par le nom de votre image.

Cdlt
 

escouger

XLDnaute Occasionnel
Bonsoir,
Merci pour cette réponse.
Cela fonctionne mais pas d'une façon très précise.
En fait la photo se place bien dans la cellule citée (qui est dimensionnée à la taille de la photo + 50 top pixels et + 50 left pixels) mais pas alignée sur le coin supérieur gauche, ce qui la fait donc déborder sur les cellules voisines.
Je m'en suis sorti en gérant une table de correspondance de chaque image avec son .top et son .left adaptés aux cellules réceptrices.
Ce n'est pas idéal même si dans mon cas c'est suffisant car le connais à l'avance toutes les photos et l'endroit ou je veux les afficher.

S'il y avait un moyen de déterminer le .top et le .left à base du premier pixel en haut et à gauche de la cellule citée ce serait ...top!

Cordialement
 

bof

XLDnaute Occasionnel
bonjour,
Utilisez la propriété TopLeftCell de Shape pour fixer les Top / Left :
Ex :
VB:
Sub test()
    With ActiveSheet.Shapes("Image 1")
        .Top = .TopLeftCell.Top
        .Left = .TopLeftCell.Left
    End With
End Sub
A+
 

escouger

XLDnaute Occasionnel
Bonjour,
Je me suis sans doute mal exprimé.
Je ne souhaite pas retrouver l'adresse du pixel en haut et à gauche de ma photo, mais placer le coin en haut et à gauche de ma photo sur le coin en haut et à gauche d'une cellule.
Il faut donc déterminer le .top et le .left de la cellule.
 

escouger

XLDnaute Occasionnel
Bonjour,
Je pense avoir (enfin!) compris comment cela fonctionne, et je m'étais compliqué la vie pour rien. La solution de Rouge marche en effet très bien et sans recours à
.Top = .TopLeftCell.Top ni .Left = .TopLeftCell.Left

Merci encore pour votre aide

Voici la macro :
' 2 onlets concernés
' Identité ou l'on trouve le nom de la personne concernée par la photo
' Trombi ou sera stockée la photo avec un emplacement réservé pour chaque personne
' la photo sera recherchée sur un répertoire quelconque

Sub newphoto()
'ouverture de la fenetre de selection des fichiers
' recherche dans un répertoire de la photo concernée
sfilter = "Excel Files (*.png), *.png"
messources = Application.GetOpenFilename(FileFilter:=sfilter, FilterIndex:=1, Title:="Selection des fichiers", MultiSelect:=True)
' ______________________________________________________________________________
For i = LBound(messources) To UBound(messources)

varnam = messources(i) ' path + nom + suffixe
varnamx = Mid(varnam, 44, 50) ' nom + suffixe
varnamy = Left(varnamx, Len(varnamx) - 4) ' nom
varnamz = "PW_" & varnamy ' nom préfixé

Next i

Sheets("Identité").Select ' onglet ou se trouve, sur la ligne courante, le nom de la photo
' le nom de la forme correspondant à la photo est "PW_nom_personne"

addr1 = "AA" & ActiveCell.Row
nameph0 = Range(addr1) ' nom de la photo à supprimer

' adresse de la photo à supprimer puis à recréer dans onglet trombi
addr2 = "Z" & ActiveCell.Row
nameph2 = Range(addr2)

Sheets("TROMBI").Select ' onglet ou sera stocké la photo

On Error GoTo bypass ' au cas ou la photo dans trombi a déjà été supprimée
ActiveSheet.Shapes.Range(Array(nameph0)).Select ' proteger par un on error goto
Selection.Delete
bypass:
' #########################################################
Dim GES As Object
Range(nameph2).Select ' emplacement de la photo dans onglet Trombi

Set GES = Sheets("Trombi").Pictures.Insert(varnam)
GES.Name = varnamz
ActiveSheet.Shapes.Range(Array(GES.Name)).Select
Selection.ShapeRange.Height = 77.9527559055 ' taille unifiée pour toutes les photos
Selection.ShapeRange.Width = 58.3937007874

' GES.Top = Range(nameph2) 'lignes inutiles du fait du range(nameph2) avant le SET GES
' GES.Left = Range(nameph2) ' ""

fin_nph:

End Sub
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…