Passer d'une image a une autre par clic dessus

Bonjour,

Après quelques recherches infructueuses, je m'en remet a votre aide pour élaborer une macro qui me permettrait de passer d'une image a une autre en cliquant dessus (j'en ai 5 en tout) avec retour a la première lorsque la rotation a été faite.

Je clarifie :

L'image 1 est affichée de base, je clique dessus elle devient la 2 je clique dessus elle devient la 3... ... arrivé a la 5e elle redevient la 1 si je clique

Merci par avance de votre aide

... Je n'ai pas précisé que les 5 images sont sur la feuille sur laquelle je souhaite mettre en action la macro

Bonjour,

ric

Bonjour,

Voici un essai où chacune des images est liée à cette macro :

Sub ProchaineImage()

Dim shactive as shape, sh as shape

set shactive = activesheet.shapes(Application.caller)
'strmacro = shactive.onaction

Reprise:
for each sh in activesheet.shapes
    'if sh.onaction = strmacro then
        if sh.name = shactive.name then prochaine = true
        if prochaine then sh.select: exit sub
    'end if
next sh
goto Reprise  

End sub

Pour affecter cette macro à chaque image :

Sub AffecterImages()

for each sh in sheets("nomfeuille").shapes '<<< PRECISER NOM DE LA FEUILLE
    sh.onaction = "ProchaineImage"
next sh

end sub

Cdlt,

@3GB : j'ai suivi la démarche mais malheureusement rien ne se passe au clic sur l'image.

Je joint un fichier pour clarifier le tout, le but étant de pouvoir changer l'image présente a droite des chiffres

34macimage.xlsx (29.49 Ko)

Bonjour à tous,

J'ai incorporé le code de 3GB à ton fichier > cela fonctionne bien > clique sur les 5 images de la colonne C ...

ric

@Ric : Et bien je doit avoir un pb car quand je clique sur une des images en colonne C, cela sélectionne l'image correspondante parmi celles disposées en haut mais celle que je viens de cliquer ne change pas

Bonjour à tous,

C'est aussi le résultat que j'obtiens > mais là > je comprends mieux ton besoin > je vais regarder ce que je peux faire en attendant que 3GB repasse ...

ric

Bonjour à tous,

Il est possible de faire très simple. On affecte à toutes les images la macro "Clic" ci-dessous :

Sub Clic()
    ActiveSheet.Shapes(Application.Caller).ZOrder 1
End Sub

Pierre

Bonjour …

J’ai peut-être mal interprété la demande*. Si c’est le cas, ne pas tenir compte de ma proposition directe.

* c’est l’image sélectionnée qui se trouve attribuée au résultat dévolu. Dans ce cas, il est possible d‘attribuer directement l’image (sans présélection) en fonction du résultat trouvé, mais c’est une autre histoire.

report d images
Private Sub Sp_Change()    ‘la toupie qui ne s’arrête pas de tourner
  If Sp = Sp.Max Then Sp = 1
  If Sp = 0 Then Sp = Sp.Max - 1
  [B3] = [NOM].Item(Sp, 1)    ‘jusqu’au nom choisi
End Sub
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  Dim n As Byte
  If R.Address = [NOM].Item(0, 1).Address Then ‘placement initial de chaque image
    For n = 1 To 5 
      Me.Shapes("ç" & n).Top = 31: Me.Shapes("ç" & n).Left = [NOM].Item(n, 3)
    Next
  Else
    If [B3] = "" Or R.CountLarge > 1 Then Exit Sub    'déplacement de l'mage
    Me.Shapes([B3]).Left = R(1, 3).Left: Me.Shapes([B3]).Top = R.Top: [B3] = ""
  End If
End Sub

@pierrep56 : votre macro ne semble pas avoir d'effet

@Ordonc : cela semble être une solution mais votre méthode présente des similitudes avec l'emploi d'une liste déroulante affectant une image suivant sa valeur qui est plus facile a mettre en oeuvre (a mon sens)

La finalité de ma demande est de pouvoir, pour chacune des 5 lignes, modifier indépendamment l'image associée en fonction de mon jugement et ceci le plus simplement possible, c'est pourquoi une macro faisant "défiler" les images par clic me semblait bien mais a priori c'est pas simple du tout...

En solution "en attendant mieux", j'ai procédé grâce a un tuto a une image qui se met en fonction d'un choix dans une liste déroulante...

Dans tous les cas j’apprécie l'aide de chacun

demo meteo
65images-ordre.xlsm (68.30 Ko)

Est-ce que j'aurai mal compris la demande?

Pierre

Bonjour à tous,

@ pierrep56 > je crois que c'est l'application de ton code qui a été mal compris > ce n'est pas ta macro qui a un souci ...

Ton code est merveilleux ...

@ Anthoony > il faut placer une série d'images > les unes par-dessus les autres > à chaque clic > la suivante se place en avant plan ...

ric

re,

en retard, mais peut-être

Edit: code de Ric et un mélange de ma part ce qui donne

ci-joint @améliorer

crdlt,

André

Bonjour à tous,

@Ric : Merci d'avoir pris le temps de tester mon code .

@pierrep56 : C'est efficace ! J'avais un doute sur la superposition mais ce serait finalement la meilleure solution.

@Anthoony : Vous devriez superposer vos images pour utiliser le code de pierrep56 ou alors faire en sorte d'obtenir vos images dans le bon ordre. Je crois que la dernière créée est par défaut en dernière position. Donc si vous copiez de la 1 à la 5 (ou sinon de la 5 à la 1 si c'est l'inverse), mon code devrait aller.

Edit : En fait, en voyant la proposition d'Andre13, je me rends compte que ma proposition n'est probablement pas adaptée.

Cdlt,

Re …

j’avais pensé à une liste de validation non pas avec des images mais avec des caractères spéciaux. Ma dernière remarque venait de ce que je ne savais pas si les choix étaient indépendants ou pas des valeurs ou d'une évaluation strictement personnelle cas par cas).

Dans cette dernière optique,

contexte

on aura une programmation très simple :

Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
  If R.Address = "$D$2" Then [D3:D11].Clear ‘utile ou pas
End Sub

Private Sub Worksheet_Change(ByVal R As Range)
  Dim C As Range
  If R.CountLarge > 1 Then Exit Sub
  If Not Intersect(R, [C3:C11]) Is Nothing And R <> "" Then
    Set C = [Nom[Nom]].Find(R)(1, 2): C.Copy R(1, 2)
    Application.EnableEvents = 0: R = "": Application.EnableEvents = 1
  End If
End Sub

Le solution de pierrep56 est exactement ce que je cherchais ! Je n'avais effectivement pas compris son fonctionnement.

Merci Beaucoup a tous !

Rechercher des sujets similaires à "passer image clic dessus"