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 job75

•>Noop123
J'ai complété mon test
(toujours sur une feuille vierge, et cette fois-ci, tu peux lancer plusieurs fois de suite la macro PreTest_II)
test OK sur Excel 2013
(La mise en forme de la shape "test" est appliquée sur les 4 formes à droite de celle-ci quand on clique sur une de ces 4 formes)

Sub PreTest_II()
Dim shp As Shape, c As Range, p As Range, x As Range, i%, vShps()
Set c = [C2]: c.RowHeight = 100: Set p = c.Offset(, 2): Randomize 1600
With ActiveSheet
.DrawingObjects.Delete
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
y = Application.RandBetween(0, 8)
shp.Fill.PresetTextured Array(4, 10, 5, 22, 16, 8, 14, 19, 18)(y)
shp.Name = "test": vShps = Array(3, 15, 14, 23)
For i = 0 To 3
Set x = p(1, (i + 1) * 2)
Set shp = .Shapes.AddShape(vShps(i), x.Left, x.Top, x.Width, x.Height)
shp.Fill.ForeColor.SchemeColor = vShps(i)
shp.OnAction = "Test_II"
Next
End With
End Sub

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

 

[Noopy123]

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

Oui j'ai bien suivi le mode d'emploi mais bizarrement j'ai essayé pas mal de technique avec le application.caller et a chaque fois j'ai un message d'erreur :/

 

[Staple1600]

Re

Le mode opératoire est le suivant
1) Dans un classeur vierge, tu inséres un module standard dans lequel tu copies/colles le code du message#16
2) Tu lances la macro PreTest_II
Puis tu cliques sur une des 4 formes à droite de "test"
Ça doit fonctionner.
(Le préfixe de ta discussion indique XL 2013, or je suis aussi sur XL 2013)

 

[Noopy123]

Bonjour job75

•>Noop123
J'ai complété mon test
(toujours sur une feuille vierge, et cette fois-ci, tu peux lancer plusieurs fois de suite la macro PreTest_II)
test OK sur Excel 2013
(La mise en forme de la shape "test" est appliquée sur les 4 formes à droite de celle-ci quand on clique sur une de ces 4 formes)

Sub PreTest_II()
Dim shp As Shape, c As Range, p As Range, x As Range, i%, vShps()
Set c = [C2]: c.RowHeight = 100: Set p = c.Offset(, 2): Randomize 1600
With ActiveSheet
.DrawingObjects.Delete
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
y = Application.RandBetween(0, 8)
shp.Fill.PresetTextured Array(4, 10, 5, 22, 16, 8, 14, 19, 18)(y)
shp.Name = "test": vShps = Array(3, 15, 14, 23)
For i = 0 To 3
Set x = p(1, (i + 1) * 2)
Set shp = .Shapes.AddShape(vShps(i), x.Left, x.Top, x.Width, x.Height)
shp.Fill.ForeColor.SchemeColor = vShps(i)
shp.OnAction = "Test_II"
Next
End With
End Sub

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

Je viens d'essayer et encore le même message d'erreur

 

[Staple1600]

Re

Pourtant cela fonctionne, la preuve

 

[job75]

Un je-m'en-foutiste ou un nul ?

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

 

[Staple1600]

Bonjour le fil, Noopy123, job75

Avec ceci, si la sélection de shapes est multiple, le changement de format s'applique sur toutes les formes sélectionnées
(Rappel: dans cet exemple, la texture présente sur "test" remplace une image, mais le résultat est le même si "test" contient une image)
le mode opératoire pour tester est différent
1) Lancer PreTest_III
Puis sélectionner une ou plusieurs shapes (autre que celle nommée "test")
et lancer ensuite (à partir de VBE) la macro Test_III

Sub PreTest_III()
Dim shp As Shape, c As Range, p As Range, x As Range, i%, vShps()
Set c = [C2]: c.RowHeight = 100: Set p = c.Offset(, 2): Randomize 1600
With ActiveSheet
.DrawingObjects.Delete
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
y = Application.RandBetween(0, 8)
shp.Fill.PresetTextured Array(4, 10, 5, 22, 16, 8, 14, 19, 18)(y)
shp.Name = "test": vShps = Array(3, 15, 14, 23)
For i = 0 To 3
Set x = p(1, (i + 1) * 2)
Set shp = .Shapes.AddShape(vShps(i), x.Left, x.Top, x.Width, x.Height)
shp.Fill.ForeColor.SchemeColor = vShps(i)
Next
End With
End Sub

Sub Test_III()
'Dans cette version, le changement s'appliquera sur les shapes sélectionnées
'soit une seule, soit sélection multiple
Dim shp As Shape
With ActiveSheet
 .Shapes("test").PickUp
    For Each shp In ActiveWindow.Selection.ShapeRange
    shp.Apply
    Next
End With
End Sub

PS: job75
Bienvenue au club des XLDdiens ostracisés ou parfois invisibles...
C'est vrai que ce n'est pas agréable (j'en sais quelque chose)

 

[Noopy123]

Re

Pourtant cela fonctionne, la preuve
Regarde la pièce jointe 1064507

Bonjour Staple1600,

C'est bon ça marche bien. Je ne sais pas ce que j'ai fais comme bêtise hier soir mais en tout cas c'est bon ça marche nickel

 

[Noopy123]

Un je-m'en-foutiste ou un nul ?

Bonjour job75
Désolé de ne pas avoir répondu immediatement, j'essaie de bien comprendre le code avant de l'utiliser et de donner mes impressions , je suis encore en phase de transcription^^

 

[Noopy123]

Bonjour le fil, Noopy123, job75

Avec ceci, si la sélection de shapes est multiple, le changement de format s'applique sur toutes les formes sélectionnées
(Rappel: dans cet exemple, la texture présente sur "test" remplace une image, mais le résultat est le même si "test" contient une image)
le mode opératoire pour tester est différent
1) Lancer PreTest_III
Puis sélectionner une ou plusieurs shapes (autre que celle nommée "test")
et lancer ensuite (à partir de VBE) la macro Test_III

Sub PreTest_III()
Dim shp As Shape, c As Range, p As Range, x As Range, i%, vShps()
Set c = [C2]: c.RowHeight = 100: Set p = c.Offset(, 2): Randomize 1600
With ActiveSheet
.DrawingObjects.Delete
Set shp = .Shapes.AddShape(1, c.Left, c.Top, c.Width, c.Height)
y = Application.RandBetween(0, 8)
shp.Fill.PresetTextured Array(4, 10, 5, 22, 16, 8, 14, 19, 18)(y)
shp.Name = "test": vShps = Array(3, 15, 14, 23)
For i = 0 To 3
Set x = p(1, (i + 1) * 2)
Set shp = .Shapes.AddShape(vShps(i), x.Left, x.Top, x.Width, x.Height)
shp.Fill.ForeColor.SchemeColor = vShps(i)
Next
End With
End Sub

Sub Test_III()
'Dans cette version, le changement s'appliquera sur les shapes sélectionnées
'soit une seule, soit sélection multiple
Dim shp As Shape
With ActiveSheet
.Shapes("test").PickUp
    For Each shp In ActiveWindow.Selection.ShapeRange
    shp.Apply
    Next
End With
End Sub

PS: job75
Bienvenue au club des XLDdiens ostracisés ou parfois invisibles...
C'est vrai que ce n'est pas agréable (j'en sais quelque chose)

Je viens d'essayer ce code mais rien ne se passe. J'ai mis Test_III dans un commandButton pour declancher la copie mais rien non plus. Sais-tu où est mon erreur ?

 

[Staple1600]

Re

•>Noopy123
Je n'ai pas parlé de CommandButton...
(Relire mon précédent message)

 

[Noopy123]

Re

•>Noopy123
Je n'ai pas parlé de CommandButton...
(Relire mon précédent message)

Oui j'ai testé le avec et le sans command button mais pas de changement des formes

 

[Staple1600]

Re

Si, il y a changement sinon pourquoi aurais-je posté ce nouveau code?

Relire attentivement le mode opératoire du message#22
(et faire exactement tout ce qu'on y lit)

NB: Je te rappelle qu'hier tu disais que cela ne fonctionnait pas
puis O surprise, ce matin, tu écris

C'est bon ça marche bien. Je ne sais pas ce que j'ai fais comme bêtise hier soir mais en tout cas c'est bon ça marche nickel

 

[Noopy123]

Finalement, j'ai trouvé un truc hyper simple qui pour l'instant marche :
J'ai crée un Bouton et je lui ai affecté cette macro et ma photo se met bien en arrière plan de mes formes séléctionnées

Sub Bouton2_Cliquer()
Selection.ShapeRange.Fill.UserPicture "C:\Users\utilisateur\Desktop\PHOTO \3.jpg"
End Sub

Par contre via ce code, si pas de cellule séléctionné ça plante. Est-il possible d'avoir un msg box si aucune shape séléctionnées et faire un exit sub ?

 

[job75]

Bonjour Noopy123, JM,

En fait l'utilisateur choisira parmi différentes images celle qu'il veut mettre dans la forme

Votre dernière solution ne choisit pas...

A+