Vba pour copier des images

Bonjour la communauté.
J’ai un classeur « Album »
Dans ce classeur : une feuille « Image »
Une feuille « classement »

Dans la feuille Image 30 images que j’ai insérées à partir d’un album quelconque.
Je voudrais en cliquant ( doubleClic ou ClicDroit) sur ces images , les coller sur la feuille classement, de la gauche vers la droite les unes après les autres dans l’ordre choisit en cliquant,
Je m’explique.
Le Clic sur image 3 la colle en haut à gauche de ma feuille.
Le Clic sur la suivante image 18 par exemple la colle en haut juste à droite de l’image 3, etc, etc.
Peut-être faut-il que les cellules qui reçoivent les images doivent être de la même dimension (ce qui ne me gène pas) soit image 3 dans cellule A1, image 18 dans cellule A2.

Merci aux courageux



Robert

bonjour,
est ce que tes images ont toutes la même taille?

Veux tu tes trente images en ligne sur la feuille de réception?

Comment faits tu pour savoir qu'une photo n'est pas déjà classée?


@+

Salut fred65200

Les images sont toutes de même dimensions
Je veux les aligner sur deux lignes pour qu'elles soit visibles sur l'écran
Lorsque c'est terminé je les sauvegardes sur un autre classeur

Merci fred

bonjour,

Voici le code, à placer dans ta feuille Images
clic droit sur l'onglet, visualiser le code

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48

Option Explicit Dim Compteur As Byte Dim Sh As Shape Dim Ligne As Byte Private Sub CommandButton1_Click() With UsedRange 'Attention efface tour le texte et les couleurs de fond, adapte au besoin .Interior.ColorIndex = xlNone .ClearContents End With   'affectation des macros aux images For Each Sh In Sheets("image").Shapes If Not Sh.Name Like "CommandButton1" Then Sh.OnAction = "Feuil1.Classement" Next Sh   'suppression des images de la feuille classement For Each Sh In Sheets("classement").Shapes Sh.Delete Next Sh   Compteur = 0 Ligne = 1   End Sub Sub Classement() Compteur = Compteur + 1   'suppression de la macro pour ne pas recliquer sur la même image 'et par la même occasion ne pas avoir d'image cliquable sur la feuille de destination Sheets("image").Shapes(Application.Caller).OnAction = ""   'copie de l'image Sheets("image").Shapes(Application.Caller).Copy   'fond de cellule rouge et position With Range(Sheets("image").Shapes(Application.Caller).TopLeftCell.Address) .Interior.ColorIndex = 3 .Value = Compteur + (Ligne - 1) * 15 End With   'collage de l'image Sheets("classement").Cells(Ligne, Compteur).PasteSpecial "Image (GIF)"   If Compteur * Ligne = 30 Then MsgBox "Classement terminé.": _ Application.Goto Sheets("classement").Range("A1"): Exit Sub   If Compteur = 15 Then Compteur = 0: Ligne = Ligne + 1 End Sub

---

Ajoute un bouton sur la feuille image et affecte lui la macro Initialisation

Dans mon exemple, j'ai mis un CommandButton1, si tu places un autre type de bouton, ajuste la macro Initialisation.
Tu peux aussi affecter le code initialisation à un bouton d'une barre d'outils. Dans ce cas supprime

Code:

---

If Not Sh.Name = "CommandButton1" Then

---

Les cellules de la feuille image doivent être légèrement plus larges et plus hautes que les images pour un confort visuel, si tu places tes images dans le coin supérieur gauche, aligne la police à droite et en bas.

Les dimensions des cellules de la feuille classement doivent correspondre aux dimensions des images.

cordialement

Merci Fred je vais essayer ta solution
A plus
Robert