XL 2010 Insérer 3 images

  • Initiateur de la discussion Initiateur de la discussion madoupa
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
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
 
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
 
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
 
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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
234
Réponses
4
Affichages
355
Réponses
7
Affichages
84
Retour