XL 2019 Affiche image sur autre feuille

[pat66]

Bonjour le forum,

Pourriez vous m'aider à adapter la macro ci dessous (récuperée sur forum) qui permet d'afficher en grand une vignette présente sur la même feuille

Mon problème c'est que j'aimerai qu'à l'aide d'un clic sur un command button ou sur une forme situé sur la feuille1, pouvoir afficher une image stockée sur la feuille2
Cette image doit être zoomée et centrée sur le feuille1 et une fois affichée, grâce à un clic sur la photo zoomée, celle ci disparait de la feuille1

Private Sub Agrandir_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
    Selection.ShapeRange.ZOrder msoBringToFront
    Selection.ShapeRange.Width = 360
    Selection.ShapeRange.Top = 8
    Selection.ShapeRange.Left = 120
    Selection.OnAction = "Diminuer_image"
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Select
    ActiveSheet.Shapes("Image 2").Visible = False
    ActiveSheet.Shapes("Image 3").Visible = False
'    ActiveSheet.Shapes("Image 2").ZOrder msobringToBack
'    ActiveSheet.Shapes("Image 3").ZOrder msobringToBack
End Sub
Private Sub Diminuer_image()
    ActiveSheet.Shapes.Range(Array(Application.Caller)).Select
'    Selection.ShapeRange.ZOrder msoSendToBack
    Selection.ShapeRange.Height = 100
    Selection.ShapeRange.Top = 180
    Selection.ShapeRange.Left = 40
    Selection.OnAction = "Agrandir_image"
    ActiveSheet.Shapes("Image 2").Visible = Not ActiveSheet.Shapes("Image 2").Visible
    ActiveSheet.Shapes("Image 3").Visible = Not ActiveSheet.Shapes("Image 3").Visible
    Range("a1").Select
End Sub

Private Sub initialiser()
    For Each Image In ActiveSheet.Shapes
       Image.OnAction = "Agrandir_image"
    Next Image
End Sub

Je vous remercie pour votre aide

Pat66

 

[job75]

Bonjour pat66, le forum,

En Feuil1 il suffit de renommer les images et de les superposer, le code de la feuille :

Private Sub CommandButton1_Click()
Afficher "Image1"
End Sub

Private Sub CommandButton2_Click()
Afficher "Image2"
End Sub

Private Sub CommandButton3_Click()
Afficher "Image3"
End Sub

Sub Afficher(nom$)
Dim liste, e
liste = Array("Image1", "Image2", "Image3") 'à adapter
For Each e In liste
    Shapes(e).Visible = nom = e
Next
End Sub

A+

 

[job75]

Avec ce fichier (2) les images sont toujours affichées.

L'image à montrer est simplement placée au 1er plan :

Sub Afficher(nom$)
Dim liste, e
liste = Array("Image1", "Image2", "Image3") 'à adapter
For Each e In liste
    Shapes(e).ZOrder -(nom <> e) '0 => 1er plan
Next
End Sub

Bien entendu il faut que les images soient exactement de mêmes dimensions et parfaitement superposées.

 

[job75]

Bien entendu il faut que les images soient exactement de mêmes dimensions et parfaitement superposées.

Pour y parvenir on peut compléter la macro, fichier (3) :

Sub Afficher(nom$)
Dim liste, e
liste = Array("Image1", "Image2", "Image3") 'à adapter
For Each e In liste
    If e <> "Image1" Then
        Shapes(e).LockAspectRatio = msoFalse
        Shapes(e).Width = Shapes("Image1").Width
        Shapes(e).Height = Shapes("Image1").Height
        Shapes(e).LockAspectRatio = msoTrue
        Shapes(e).Top = Shapes("Image1").Top
        Shapes(e).Left = Shapes("Image1").Left
    End If
    Shapes(e).ZOrder -(nom <> e) '0 => 1er plan
Next
End Sub