XL 2013 Image dans shape

[Noopy123]

Bonjour,

Est-il possible d'ajouter une image dans une shape sélectionnée ?
J'ai un fichier qui créé un nombre aléatoire de rectangle et j'aimerais mettre une image en fond dans les rectangles que j'ai préalablement sélectionné. Le top serait de le faire via un double clique sur la cellule sélectionnée

Merci par avance

 

[Staple1600]

Bonjour le fil

•>Noopy123
Il serait judicieux de mettre un lien vers ta précédente discussion puisque celle-ci en est est la suite, non ?
Et pourquoi ne pas directement insérer les images dans les cellules ?
(Les fusionnées et les non-fusionnées )

 

[Noopy123]

Malheureusement j'aimerais que ce soit aussi simple :/
En fait l'utilisateur choisira parmi différentes images celle qu'il veut mettre dans la forme

 

[Staple1600]

Re

Dans ce cas, regarde déjà à droite de ton écran pour y trouver quelques inspirations.
Puisque tu rechignes à mettre le lien, je le fais...

https://www.excel-downloads.com/threads/nommer-suite-de-shape.20044540/page-2#post-20325976

(Cela pourra éclairer la lanterne d'éventuels répondeurs)

 

[Noopy123]

Je n'ai pas réussi à trouver mon bonheur à droite car à chaque fois c'est sur une plage de donnée définie
En gros, je veux faire dire à mon code :
Pour chaque shape séléctionné, mettre cette photo en fond.
C'est surtout la partie pour chaque shape séléctionné qui me pose problème parce que pour le reste je pensais passer par l'enregistreur de macro

 

[Staple1600]

Re

J'ai bien compris

NB: Il n'y a pas que la droite, il y haut le coin en haut à droite...

Effectuez une recherche sur Excel Downloads...

www.excel-downloads.com

Sub Grille_POUR_TEST_II()
Dim c As Range, m As Range, Grille As Range, shp As Shape
If TypeName(Selection) = "Range" Then
Set Grille = Selection.Item(1).Resize(6, 6)
Grille.RowHeight = 50: Grille.ColumnWidth = 4.86
Grille(6, 4).Resize(, 3).Merge: Grille(4, 1).Resize(, 2).Merge
Grille(4, 3).Resize(, 2).Merge: Grille(4, 5).Resize(, 2).Merge
Grille(6, 1).Resize(, 3).Merge: Grille(2, 2).Resize(, 2).Merge
With ActiveSheet
For Each c In Grille
If c.MergeCells Then
Set m = c(1).MergeArea
Set shp = .Shapes.AddShape(1, m.Left, m.Top, m.Width, m.Height)
shp.Line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
Else
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
shp.Line.ForeColor.RGB = RGB(192, 0, 0): shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
End If
shp.Name = "img_" & shp.ZOrderPosition
shp.OnAction = "Test"
Next
End With
End If
End Sub
Sub Test()
Pict = Application.GetOpenFilename("Fichiers Images ,*.gif;*.jpg;*.png")
If Pict <> False Then
ActiveSheet.Shapes(Application.Caller).Fill.UserPicture Pict
End If
End Sub

 

[Noopy123]

Merci pour ton retour,

L'idée est bonne mais j'aimerais que les choses se fasse indépendamment. C'est à dire dans un premier temps l’enchaînement des formes se fait. Une fois le plan créé, l’utilisateur clique sur la forme qu'il veut et là il met sa photo.
D'où le fait que j'aimerais savoir comment "coder" Pour chaque shape sélectionnées dans le document.

 

[Staple1600]

Re

Tu as essayé le code du message#6?
Puis tu as essayé de cliquer sur une forme?

 

[Noopy123]

Yes, mais ce n'est pas vraiment le résultat cherché
L'utilisateur ne peut pas seléctionner 2 shapes s'il le veut

 

[Staple1600]

Re

Ah bon?
Pourtant mon code fait ce qu'on peut lire dans le message#1...

Est-il possible d'ajouter une image dans une shape sélectionnée ?

 

[Noopy123]

Effectivement, il marche bien pour un shape sélectionner mais ça ne match pas s'il faut en sélectionner 2 ça ne fonctionne pas

 

[Staple1600]

Re

Vois ce que ce petit test t'inspire*
(A tester sur une feuille vierge)
1) Lancer la macro: PreTest
2) Clique ensuite sur le rectangle bleu.
(NB: Si la Shape "test" contenait une image, l'effet serait le même)

Sub PreTest()
Dim shp As Shape, shpB As Shape, c As Range, p As Range
Set c = [C3]
c.RowHeight = 100
Set p = c.Offset(, 5)
With ActiveSheet
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
shp.Fill.PresetTextured msoTextureFishFossil
shp.Name = "test"
Set shpB = .Shapes.AddShape(1, p.Left, p.Top, p.Width, p.Height)
shpB.OnAction = "Test_II"
End With
End Sub

Sub Test_II()
With ActiveSheet
 .Shapes("test").PickUp
 .Shapes(Application.Caller).Apply
End With
End Sub

*: c'est donc une piste à suivre, pas une solution 100% finalisée
Donc inutile de me sortir ce genre de réponse

Yes, mais ce n'est pas vraiment le résultat cherché

 

[Noopy123]

*: c'est donc une piste à suivre, pas une solution 100% finalisée
Donc inutile de me sortir ce genre de réponse

Tu es tatillon, je ne vais plus comment répondre, tu as à redire sur toutes mes réponses

Revenons à nos moutons ^^
Quand je clique que la forme bleue voila ce qui apparaît :/

 

[Staple1600]

Re

Tu as testé sur une feuille vierge?
Tu as bien mis le code dans un module standard?

PS: Je ne suis pas tatillon, juste un tantinet ironique
Mais j'avais prévenu
Ce lien n'existe plus

 

[job75]

Bonsoir Noopy123, JM,

Voyez le fichier joint et cliquez sur la Shape que vous voulez traiter dans la 1ère feuille.

A+