XL 2010 Insérer 3 images

[madoupa]

S'il vous plait j'ai un code VBA pour insérer 2 images, je veux ajouter une 3 image.
Merci d'avance.

Private Sub UserForm_Activate()
  Dim Emplacement As Range
  Dim img As Object
  Dim ShapeObj As Shape, i%
 
  'Boucle pour supprimer les images sauf le bouton
  For Each ShapeObj In Sheets("feuil1").Shapes
      If ShapeObj.Name = "Cible1" Then ShapeObj.Delete
  Next ShapeObj
  Sheets("feuil1").Activate
  If Application.Dialogs(xlDialogInsertPicture).Show Then
      For i = 1 To 2 'Boucle pour 2 images
        If i = 1 Then '1ère image
          Set Emplacement = Range("I4:I9") '1er emplacement
        Else 'sinon pour 2ème image, copie de la première
          ActiveSheet.Shapes.Range(Array("Cible1")).Select
          Selection.Copy
          ActiveSheet.Paste
          Set Emplacement = Range("I30:I35") '2ème emplacement
        End If
        Set img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
        With img.ShapeRange
          'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
          .Name = "Cible1" 'Nomme les images 1 ou 2
          .LockAspectRatio = msoFalse
          .Left = Emplacement.Left
          .Top = Emplacement.Top
          .Height = Emplacement.Height
          .Width = Emplacement.Width
      End With
      Next i
  Else
      MsgBox "Insertion d'image interrompue."
  End If
  End Sub

 

[Staple1600]

For i = 1 To 2 'Boucle pour 2 images

3 vient après 2, non ?

NB: je t'imite: je dis pas Bonjour ou Bonsoir

 

[madoupa]

Bonsoir Staple1600

 

[Staple1600]

Bonsoir @madoupa

Ce que je disais précédemment reste vrai
Si tu veux trois images alors, ca commence comme cela, non ?
For i = 1 To 3 'Boucle pour 3 images

 

[madoupa]

oui je sais "boucle à 3 image", mais SVP je ne sais pas comment modifier ce code pour avoir une 3eme image dans "I50,I55" avec les 2 premires images.
je suis pas fort en VBA.

 

[Staple1600]

Re

J'ai relu ton code initial
En fait tu veux dupliquer trois fois une image qui est déjà sur une feuille, non ?

Dans ce cas, ce code fait cela
NB: Changer le chemin du dossier et le nom de l'image pour faire le test.

Sub Macro1()
Dim shp As Shape
pos = Array(250, 400)
Set shp = ActiveSheet.Shapes.AddPicture("C:\Users\STAPLE\Pictures\test.png", True, True, 100, 100, 100, 100)
For i = 1 To 2
Set shp = shp.Duplicate
shp.Left = pos(i - 1)
shp.Top = 100
Next
End Sub

 

[madoupa]

Merci staple1600
mais ce que je voulais c'est modifier mon code pour avoir la possibilité d'insérer 3 images dupliquées dans 3 zones différentes de ma feuille
je veux ajouter la phrase suivante dans mon code

Set Emplacement = Range("I50:I55") '3ème emplacement

 

[Staple1600]

Re


Test OK avec ce petit exemple
Il te faudra adapter les adresses des cellules et nommer ton image à dupliquer
Ici dans mon test, je l'ai nommé toto
Les copies vont se mettre en F4 puis en K4 dans cet exemple.

Sub macro2()
Dim shp As Shape
Set shp = ActiveSheet.Shapes("toto")
vArr = Array("F4", "K4")
For i = 1 To 2
Set shp = shp.Duplicate
    With shp
    Adr = vArr(i - 1)
        .Top = Range(Adr).Top
        .Left = Range(Adr).Left
    End With
Next
End Sub

 

[madoupa]

Bonsoir,
merci beaucoup staple1600 pour votre aide
voila mon fichier pour être plus précis

 

[Staple1600]

Bonsoir @madoupa

Pourquoi ne trouve-t-on pas trace de ma macro du message#8 dans ton fichier?
(avec tes différents essais et modifications)

 

[Staple1600]

Re

En me basant sur ton fichier, il suffisait de simplement modifier ainsi, non ?

Sub Macro2_BIS()
Dim shp As Shape
Set shp = ActiveSheet.Shapes("Cible1")
vArr = Array("F4", "I4")
For i = 1 To 2
Set shp = shp.Duplicate
    With shp
    Adr = vArr(i - 1)
        .Top = Range(Adr).Top
        .Left = Range(Adr).Left
    End With
Next
End Sub

 

[madoupa]

Merci beaucoup staple1600