Macro: Insertion photos dans plusieurs cellules

Bonjour à tous,

Ne trouvant aucune réponse à mes recherches, je me suis dis : je vais poser ma question directement!

J'essaie tant bien que mal d'insérer des photos pour l'édition de petites cartes en plusieurs exemplaires . Pour 1 référence d'article j'ai 1 photo. La macro que j'utilise actuellement me permet d'insérer 1 photo dans 1 cellule au format que je veux, donc jusque la tout va bien.

Cependant je dois répéter l'opération pour chaque cartes. Exemple je veux 5 cartes alors j'ai 5 macros, 1 pour chaque cellule...

Mon objectif est d'avoir 1 macro qui insère la même photo dans plusieurs cellules en 1 fois!

Voila ma macro actuelle :

Sub Macro1()
    Dim Photo As Variant
    Dim Gauche, Sommet, Largeur, Hauteur As Single

    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    Gauche = Range("B29").Left
    Sommet = Range("B29").Top
    Largeur = Range("A85").Width
    Hauteur = Range("A85").Height

    If Photo <> False Then
        Feuil1.Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
    End If
End Sub

Pour cette macro mon image est insérer dans la cellule B29, avec une largeur et une hauteur de A85 ( correspondant au format que je désire).

Ma question :Si je veux que l'image apparaissent dans la cellule B29 ET I11 dans ce même format que faut-il que je rajoute dans la macro ?

Merci pour vos réponses, si je ne suis pas clair dites-le moi

Bonjour,

Compte tenu de ta façon de procéder, je conseillerais ceci :

Dim Photo

Sub SélectionPhoto()
    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    If Photo = False Then MsgBox "Aucune photo identifiée. Recommencer", _
     vbInformation, "Erreur"
End Sub

Sub ApposerPhoto()
    Dim Gauche!, Sommet!, Largeur!, Hauteur!
    Gauche = ActiveCell.Left
    Sommet = ActiveCell.Top
    Largeur = Range("A85").Width
    Hauteur = Range("A85").Height
    On Error Resume Next
    ActiveSheet.Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
End Sub

Tu mets ce code dans un module standard. La variable Photo est déclarée niveau module, elle sera donc conservée une fois initialisée.

Inutile de la typer Variant, Variant est le type qui s'impose lorsque tu n'en mets pas !

Ta première procédure mémorise le chemin du fichier photo. Tu ajoutes le test pour vérifier que l'opération n'a pas échouée...

Ta deuxième procédure va insérer la photo autant de fois que tu veux, dans la cellule que tu auras sélectionné avant de la lancer, et sur n'importe quelle feuille.

Par contre, s'agissant de tes variables Single, toutes doivent être typées individuellement. Celles qui ne le sont pas explicitement sont de type Variant. ! remplace As Single, ce qui raccourcit...

A toi de rattacher les macro à des boutons, ou raccoucis clavier, ou les lancer simplement par la boîte dialogue macro...

NB- Utilise la balise Code pour rendre plus lisible le code que tu mets dans un post.

Et indente le code de tes macro si tu veux qu'elles soient parfaitement lisibles !

Cordialement.

Merci pour ta réponse MFerrand !

Tu as résolues mon problème en ce qui concerne le nombre de macro que j'utilise --> 1 macro pour insérer X images dans X cellules.

Cependant j'aimerai pouvoir insérer la même photo dans X cellules en 1 seule fois au lieu de X fois. Si je sélectionne plusieurs cellules puis j'exécute la macro l'image sera dans la première cellule sélectionnée uniquement...

    Dim Gauche!, Sommet!, Largeur!, Hauteur!
    Gauche = ActiveCell.Left
    Sommet = ActiveCell.Top

Est-il possible d'indiquer ici les cellules ou je veux insérer ma photo ? ou peut-être qu'il faut procéder autrement je ne sais pas

Merci pour ta réponse MFerrand !

Tu as résolues mon problème en ce qui concerne le nombre de macro que j'utilise --> 1 macro pour insérer X images dans X cellules.

Cependant j'aimerai pouvoir insérer la même photo dans X cellules en 1 seule fois au lieu de X fois. Si je sélectionne plusieurs cellules puis j'exécute la macro l'image sera dans la première cellule sélectionnée uniquement...

    Dim Gauche!, Sommet!, Largeur!, Hauteur!
    Gauche = ActiveCell.Left
    Sommet = ActiveCell.Top

Est-il possible d'indiquer ici les cellules ou je veux insérer ma photo ? ou peut-être qu'il faut procéder autrement je ne sais pas

Ça c'est la méthode simple !

Le lancement de la macro c'est un clic.

Sinon, il faut que tu fasses précéder de la mémorisation des cellules que tu indiques : par Application.InputBox par exemple, tu sélectionnes chaque cellule tour à tour et tu valides, un tableau est constitué au moyen d'une boucle, et quand tu indiques que c'est fini, l'opération s'exécute en une fois...

Mais au total, tu auras fait au moins autant de clics, cela n'aura pas pris moins de temps, et je ne compte pas le temps d'écrire la macro !

D'où, pour moi, le gain est nettement insuffisant.

Cordialement.

D'accord!

Et autrement qu'en sélectionnant tour à tour les cellules, par exemple en les nommant dans la macro elle -même ce n'est pas possible ?

Désolé si j'insiste c'est parce que j'ai au total 300 photos a insérer 20 fois dans 20 cellules donc il faudrait que je fasse 6000 fois la démarche de sélection de cellules+ lancement macro contre 300 fois si les photos sont directement insérer dans les 20 cellules en 1 seul fois (sans sélection tour à tour bien évidemment). Si toute fois cela devient trop complexe et long a programmer je ferai cette manip 6000 fois !

Merci pour tes réponses MFerrand

Tu oublies que tu vas devoir modifier 300 fois ta macro...

Dans ce cas, il faut faire une seule macro en listant les photos et les cellules, éléminerle GetOpenFilename, et au final la macro fera d'un seul coup les 300 photos 20 fois par photo !

Non en principe je n'ai pas besoin de modifier 300 fois ma macro !

Peut être me suis-je mal exprimé. Je reprends, je veux insérer 20 fois la même photos dans 20 cellules pré-définis. Après quoi je lancerai l’impression de mes 20 cartes. J'insère ensuite une nouvelle photo 20 fois dans les 20 cellules ( les 20 cellules sont identique à la "série" précédente!) , j'imprime et ainsi de suite pour 300 photos différentes.

Au final, la seule chose qui varie ce sont les photos ! Donc j'ai juste a sélectionner le chemin d'accès à la photo comme la macro me le demande quand je l'éxécute et pas modifier la macro 300 fois, enfin il me semble!

Ok, liste tes 20 cellules alors, et on intègrera ça.

Il n'en reste pas moins que tu vas actionner ta macro 300 fois, et naviguer sur ton disque pour lui désigner la photo.

Cordialement.

MFerrand a écrit :

Il n'en reste pas moins que tu vas actionner ta macro 300 fois, et naviguer sur ton disque pour lui désigner la photo.

Oui absolument.

Voila la listes de mes 20 cellules : B11, B29, B46, B64, I11, I29, I46, I64, P11, P29, P46, P64, W11, W29, W46, W64, AD11, AD29, AD46, AD64.

Merci

Bonjour,

Sub ApposerPhoto()
    Dim Photo, Gauche!, Sommet!, Largeur!, Hauteur!
    Dim lig, i%, k%
    Photo = Application.GetOpenFilename("Images JPEG (*.jpg), *.jpg")
    If Photo <> False Then
        Largeur = Range("A85").Width
        Hauteur = Range("A85").Height
        lig = Array(11, 29, 46, 64)
        For i = 0 To 3
            For k = 2 To 30 Step 7
                Gauche = Cells(lig(i), k).Left
                Sommet = Cells(lig(i), k).Top
                ActiveSheet.Shapes.AddPicture Photo, True, True, Gauche, Sommet, Largeur, Hauteur
            Next k
        Next i
    End If
End Sub

Cordialement.

Bonjour,

beaucoup pour ton aide précieuse MFerrand ca fonctionne exactement comme je le voulais!

Pour la fonction suppression des anciennes photos je verrai plus tard, je vais avancer dans mon travail mais vous n’êtes pas a l'abri que je pose cette question plus tard ahah !

Pour supprimer avant de remettre une autre photo, mettre en début de macro :

Sub ApposerPhoto()
    Dim Photo, Gauche!, Sommet!, Largeur!, Hauteur!
    Dim lig, i%, k%
    With ActiveSheet
        For i = .Shapes.Count To 1 Step -1
            .Shapes(i).Delete
        Next i
    End With
        '...

Alors j'ai essayé, ça fonctionne mais pour le coup la macro supprime aussi les objets (genre des flèches) que j'aimerai conserver sur mes cartes en permanence, et puis ça supprime aussi mon bouton macro !

En cherchant un peu sur le forum j'avais trouver cela :

Dans cet exemple , l'image insérée à l'emplacement de la plage D3:E8 est automatiquement nommée "Cible"

si le nom de l'image existe déja dans la feuille , l'ancienne image est supprimée

Sub InsertionImage()
Dim Emplacement As Range
Dim image As Object
Dim ShapeObj As Object

On Error GoTo fin:
For Each ShapeObj In ActiveSheet.DrawingObjects ' boucle pour supprimer ancienne image
If ShapeObj.Name = "cible" Then ActiveSheet.Shapes("cible").Delete
Next ShapeObj

Application.Dialogs(xlDialogInsertPicture).Show
Set Emplacement = Range("D3:E8")

Set image = ActiveSheet.DrawingObjects(2) 'adapter selon nombre total de shapes dans feuille
With image.ShapeRange
.Name = "cible" ' nommer l'image insérée ( pour la supprimer plus facilement ensuite )
.LockAspectRatio = msoFalse
.Left = Emplacement.Left
.Top = Emplacement.Top
.Height = Emplacement.Height
.Width = Emplacement.Width
End With

Exit Sub
fin:
If Err = 1004 Then MsgBox "Insertion d'image interrompue . "
End Sub

J'ai essayé de l'adapter à la macro que tu m'as proposé MFerrand mais le résultat obtenus était la suppression de tout les objets donc pas satisfaisant...

Désolé, je n'ai jamais eu ton classeur sous les yeux. Il faut renommer les objets Shape que tu veux conserver, avec un nom commençant par un préfixe commun ("zzz" par exemple, ou shp, ou ce que tu veux) et on mettra des exclusions aux suppressions.

J'espère que tu n'as pas de liste déroulante de validation, car dans ce cas ce sera les photos qu'il faut nommer.

Et c'est toujours une mauvaise idée de chercher du code sur internet !

Je ne sais pas renommé mes objets... Je te joint mon classeur allégé, les objets que je souhaite conserver sont les flèches (2/cartes) et le bouton " insérer photos". Je n'ai pas de liste déroulante heureusement.

MFerrand a écrit :

Et c'est toujours une mauvaise idée de chercher du code sur internet !

Si je peux trouver la solution sans demander de l'aide à chaque fois, c'est plus pratique pour tout le monde

Bonjour,

Il a semblé plus opportun de nommer les photos...

La proc. est mise à jour.

J'en ai ajouté une pour supprimer de façon autonome si besoin (accessible par la boîte de dialogue macro).

Je t'ai mis les indications pour renommer manuellement une forme dans une feuille (que tu supprimeras...)

Cordialement.

J'ai (encore) un soucis, quand j' exécute la macro " ApposerPhoto" j'ai un message d'erreur :Erreur d'exécution '70' Permission refusée.

Je suis aller voir ce que cela signifie mais j'arrive pas a régler le problème.

La ligne de code qui pose problème semble etre :

ActiveSheet.Shapes.AddPicture(Photo, True, True, Gauche, Sommet, Largeur, Hauteur) _

.Name = "ph" & n

A noter que le blocage survient pour n=5, donc il m'insère 5 photos correctement nommées ph1.... ph5 sur la ligne 11 puis l'erreur survient quand la macro doit insérer les photos sur la ligne 29

Je n'ai donc pas pu tester la macro "SupprimerPhoto"

PS: Merci pour la feuille "Notes" !

Ôte-moi d'un doute, l'erreur n'est pas dans le fichier que j'ai transmis ?

C'est très étrange tout ca!

Voici précisément ce que je fais :

1- J'ouvre ton fichier, je lances la macro "ApposerPhoto" , les 20 photos sont correctement intégrer !

2- Je teste la macro "SupprimerPhoto", elle semble tourner en rond, rien ne se passe...

3- Je supprime manuellment les photos

4-Je relances la macro "ApposerPhoto" et cette fois l'erreur 70 survient avec les infos que j'ai transmis ci-dessus ...

C'est donc bien dans le fichier que tu m'as transmis.