XL 2010 Insérer 3 images

madoupa

XLDnaute Nouveau
S'il vous plait j'ai un code VBA pour insérer 2 images, je veux ajouter une 3 image.
Merci d'avance.
VB:
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

XLDnaute Barbatruc
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.
Enrichi (BBcode):
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

XLDnaute Nouveau
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
VB:
Set Emplacement = Range("I50:I55") '3ème emplacement
 

Staple1600

XLDnaute Barbatruc
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.
VB:
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
 

Staple1600

XLDnaute Barbatruc
Re

En me basant sur ton fichier, il suffisait de simplement modifier ainsi, non ?
Code:
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
 

Discussions similaires

Réponses
16
Affichages
1 K

Statistiques des forums

Discussions
311 540
Messages
2 080 532
Membres
101 234
dernier inscrit
Layani89