recherche des valeurs pour inserer une image

Le 31/01/21 Í  11:28, domicol a écrit :

Bonjour,
je voudrai insérer une image en fonction du résultat de la case A9 (case
variable en manuel)
les infos du positionnement (case de ref , letf ; top )de l image Í  insérer
sont sur la même feuille de P2 a T8
voici mon exemple
https://www.cjoint.com/c/KAFqzAETcVF
merci

Bonjour,

A ) En colonne "P", insère le chemin et le nom de l'image pour chacune.
B ) Copie le code dans un module standard de ton classeur.
C ) L'image indiquée dans la colonne P va s'insérer automatiquement dans
Í  l'adresse définie en colonne Q.
D ) L'image va occuper la totalité de la cellule indiquée.

Désolé, mais je n'ai pas compris ce que veux dire, les informations
"Left" et "top" des colonnes S et T.

Il ne reste plus qu'Í  exécuter la macro test.


'-----------------------------------------
Sub test()
Dim Rg As Range, C As Range
'Nom de l'onglet de la feuille "Feuil1"
With Worksheets("Feuil1")
For Each C In .Range("R3:R8")
'.name = Nom de la feuille "Feuil1"
'.Range(C.Value) = l'adresse de la cellule o͹ sera l'image
'C.Offset(, -2) = Chemin et nom de l'image dans la colonne P
InsérerImage .Name, .Range(C.Value), C.Offset(, -2)
Next
End With
End Sub

'-----------------------------------------
Sub InsérerImage(Feuille As String, RgImage As Range, NomImage As String)
Dim Rg As Range
Set Rg = Worksheets(Feuille).Range(RgImage.Address)
With Rg
Largeur = .Offset(, 1)(, .Columns.Count).Left - .Left
Hauteur = .Offset(.Rows.Count).Top - .Item(1).Top
Set image = Worksheets(Feuille).Pictures.Insert(NomImage)
End With
With image
With .ShapeRange
.LockAspectRatio = msoFalse
.Left = Rg.Left
.Top = Rg.Top
'Largeur de l'image
.Width = Largeur
'Hauteur de l'image
.Height = Hauteur
'Est-ce que l'image doit se déplacer avec les cellules
'voici les 3 constantes possibles
End With
.Placement = xlFreeFloating 'or xlmove or xlMoveAndSize
'Verrouillé ou pas
.Locked = True 'or False
End With
Set Rg = Nothing

End Sub
'-----------------------------------------

MichD