recherche des valeurs pour inserer une image

Le
domicol offline Hors ligne
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
  • Partager ce contenu :
Vos réponses
Trier par : date / pertinence
MichD
Le #26566725
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
Poster une réponse
Anonyme