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
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.
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
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
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
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