Discussion :

[bobafric]

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

[fred65200]

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?


@+

[bobafric]

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

[fred65200]

bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[bobafric]

Merci Fred je vais essayer ta solution
A plus
Robert