Copier/coller UNE image avec VBA

Bonjour à tous,

Je travaille sur un projet dans lequel j'aurais besoin de faire une opération très simple à réaliser avec la souris, mais qui me pose problème avec VBA :

Dans ma "Feuil2" j'ai :

• colonne A : des noms ... Pierre, Paul, Marie ...
• colonne B : des chiffres par exemple ...
• colonne C : des images --> chaque image porte le nom inscrit sur sa ligne dans la colonne A.

Dans ma "Feuil1" j'ai :

• En A3 (par exemple ...) j'ai écrit un prénom.
• En J5, je voudrais collé l'image correspondant au prénom.

Comment, avec VBA (je dois intégrer cette manipulation à mon script ...) je peux faire pour :

1) supprimer l'image qui aurait été copié avant que je choisisse Marie (en J5).

2) copier l'image du prénom que j'aurais écris

3) coller cette image en J5

Je vous mets un fichier en exemple avec ce que je viens de décrire :

j'avais testé quelques idées, mais rien ne fonctionne ...

Sub Image ()
Dim Img As Object
    For Each Img In Worksheets("Feuil1").Shapes
     Img.Delete
    Next

End Sub     

--> Efface TOUTES les objets ... même les boutons que j'ai dans mon fichier de travail ...

Sub Image ()

Dim Emplacement As Range
Dim Img As Object
Dim ShapeObj As Shape
Dim Nom As string

With Sheets("Feuil1")
Nom=Sheets("IFeuil1").Cells(3, 1) 'Pour que mon programme fonctionne pour tous les noms sans modifier le script ...

    If Application.Dialogs(xlDialogInsertPicture).Show Then   'j'ai trouvé cette fonction dans un forum ... mais je ne comprends pas sont fonctionnement ... A chaque fois une boite de dialogue s'ouvre our que je choisisse une image dans mon ordi ...

 'Définit l'emplacement de l'image
        Set Emplacement = Range("J5:M15")
        Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

        With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = [i]Nom choisi[/i]
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With

    Else
        MsgBox "Insertion d'image interrompue."      'Pour le fun ;p
    End If

End Sub

Bref, là je n'ai plus d'idée !!

Merci d'avance pour votre aide !

Personne n'a d'idée ? :'(

Bonjour et bienvenue sur le forum

Pour ce qui est :

1) supprimer l'image qui aurait été copié avant que je choisisse Marie (en J5).

Et bien, là, non, je n'ai pas d'idée.

Pour le reste vois le doc ci-joint.

Te convient-il ?

J'ai réussi la première étape : Supprimer l'image déjà présente sur la "feuil1" :

'Je défini Img comme étant un objet
Dim Img As Object

'Pour travailler avec la "Feuil1"
With Sheets("Feuil1")
    Set Emplacement = Range("J5:M15")
    Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)
         Img.Delete
End With

je regarde pour la suite :

Comment faire pour copier une image de la "Feuil2" en fonction du prénom écris dans la cellule A3 de la Feuil1 ? (Sachant que l'image a été renommé avec le "prénom" choisi ... pour le prénom Pierre, il n'y a qu'une seule image nommée Pierre ...).

Ou si vous avez une autre idée pour copier l'image de la Feuil2 qui est située sur la même ligne que le prénom choisi .... et la copier dans le Feuil1 en J5 ... je prends )

Merci A+

gmb a écrit :

Bonjour et bienvenue sur le forum

Pour ce qui est :

1) supprimer l'image qui aurait été copié avant que je choisisse Marie (en J5).

Et bien, là, non, je n'ai pas d'idée.

Nos messages se sont croisés. Pour ce point là j'ai trouvé ^^

Pour le reste vois le doc ci-joint.

Te convient-il ?

Je regarde tout de suite

Merci !!

Merci gmb c'est exactement ça !!

Je vais le transposer avec le reste de mon code

Merci beaucoup ^^

Je retire ce que j'ai dit !!

Je ne sais pas pourquoi, avec ce code, je supprime de nouveau le bouton et l'image ... :/ Try again !

J'ai réussi la première étape : Supprimer l'image déjà présente sur la "feuil1" :

CODE: TOUT SÉLECTIONNER

'Je défini Img comme étant un objet

Dim Img As Object

'Pour travailler avec la "Feuil1"

With Sheets("Feuil1")

Set Emplacement = Range("J5:M15")

Set Img = ActiveSheet.DrawingObjects(ActiveSheet.Shapes.Count)

Img.Delete

End With

Essaie ces nouvelles versions :

Pas tout à fait

J'ai renommé mon bouton : "Bouton" pour ne plus être embêtée ... MAIS j'ai la petite flèche de la liste déroulante qui disparaît ... :/ Alors j'ai aussi intégré une condition pour la cellule D3 dans laquelle il y a ma liste déroulante (pour les prénoms ... je ne les écris pas, je les selectionne dans la liste ...). J'obtiens le code suivant :

Sub SuppImage ()

Dim Nb As String
Dim Img As Shape

With Sheets("INDEX")
    Nb = ActiveSheet.Shapes.Count
    For Each Img In ActiveSheet.Shapes
        If Left(Img.Name, 7) <> "D3" Then
          ElseIf Left(Img.Name, 7) <> "Bouton" Then
            Img.Delete
        End If
    Next Img
End With

End sub

Mais comme ça mon image n'est plus supprimée ! Je ne sais pas quoi faire

Est-ce que quelqu'un saurait comment supprimer une image lié à une cellule ?

Alors je pense que le plus simple est de cibler la/les cellules concernées avec "range()" et de supprimer ce qui s'y trouve ...

Un solution rapide qui à l'air de fonctionner c'est

With Sheets("Feuil1")

Range("J5:M15").Delete

End With

j'efface tout ... Si quelqu'un a une idée plus propre :p je prends ! Sinon je crois que tout fonctionne ^^

Merciiiiiiii

Bonjour à tous,

Je me permets de relancer cette discussion car j'ai plus ou moins le même problème mais que je n'arrive pas à résoudre avec les fichiers que vous avez précédemment envoyés.

Je cherche a copier une image à partir d'une base donnée de produits afin de réaliser une "fiche produit" (maquette pré-rempli, la macro servant uniquement à prendre les infos nécessaires). Mais comme l'image est sur la cellule cela ne fonctionne pas...

J'aimerais donc copier l'image sur une deuxième feuille sans avoir à la supprimer sur la première.

Je suis novice sur VBA, voilà ce que j'ai fais pour le moment :

Sub print_product_form()
Dim i As Integer

i = 1
While Feuil1.Cells(i, 2) <> Feuil1.Cells(2, 28)
i = i + 1
Wend
'trouve le produit dont je vais copier les infos

Feuil2.Cells(8, 1) = Feuil1.Cells(i, 2)
Feuil2.Cells(9, 1) = Feuil1.Cells(i, 3)
Feuil2.Cells(25, 8) = Feuil1.Cells(i, 6)
Feuil2.Cells(26, 8) = Feuil1.Cells(i, 12)
Feuil2.Cells(27, 8) = Feuil1.Cells(i, 11)
Feuil2.Cells(28, 8) = Feuil1.Cells(i, 13)
Feuil2.Cells(29, 8) = Feuil1.Cells(i, 19)
Feuil2.Cells(34, 1) = Feuil1.Cells(i, 21)
Feuil2.Cells(35, 1) = Feuil1.Cells(i, 22)
Feuil2.Cells(36, 1) = Feuil1.Cells(i, 23)

End Sub

La base de données est en feuil1 et la "fiche produit" en feuil2. L'image à copier est en feuil1.cells(i,24).

Pouvez-vous m'aider ?

En vous remerciant,

Télio