XL 2019 Affiche image sur autre feuille

pat66

XLDnaute Impliqué
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

VB:
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
 

Pièces jointes

  • Affiche Image sur feuil1.xlsm
    240.3 KB · Affichages: 14
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour pat66, le forum,

En Feuil1 il suffit de renommer les images et de les superposer, le code de la feuille :
VB:
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+
 

Pièces jointes

  • Affiche Image sur feuil1(1).xlsm
    249 KB · Affichages: 9

job75

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

L'image à montrer est simplement placée au 1er plan :
VB:
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.
 

Pièces jointes

  • Affiche Image sur feuil1(2).xlsm
    249.8 KB · Affichages: 8

job75

XLDnaute Barbatruc
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) :
VB:
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
 

Pièces jointes

  • Affiche Image sur feuil1(3).xlsm
    251.1 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
314 633
Messages
2 111 418
Membres
111 127
dernier inscrit
flygreg