Zoom image

Bonsoir à tous,

J'ai ce fichier(ci-joint) qui a une fonction de clic sur image qui provoque son agrandissement, puis redimensionnement au second clic.

Le problème est que l'agrandissement est trop fort.

Mon vœu serait qu'il soit multiplié par 3 ou 4 au maximum.

Je triture le code mais n'obtient pas de résultat.

Merci de votre retour,

Cordialement

87zoom.xlsm (62.04 Ko)

Bonsoir preststeph,

Change le code comme ci dessous afin d’affecter un zoom personnalisé en fonction d'un range:

' Zoom une image, ou supprime l'image zoomée
Public Sub ZoomUnZoomImage()
Dim oImg As Excel.Shape
' Supprime toutes les images zoomées
UnZoomImage ActiveSheet
If Not Application.Caller Like "Zoom*" Then
    ' => Si clic sur miniature
    ' oImg = Shape sur laquelle on a cliqué
    Set oImg = ActiveSheet.Shapes(Application.Caller)
    ' Travail sur une image dupliquée
    With oImg.Duplicate
        ' Positionne et redimensionne l'image pour couvrir la surface visible
        .Left = Range("A1:C10").Left
        .Top = Range("A1:C10").Top
        .Width = Range("A1:C10").Width
        .Height = Range("A1:C10").Height
        ' Renomme l'image zoomée = Zoom + nom de la miniature
        .Name = "Zoom" & oImg.Name
    End With
End If
End Sub

Merci pour ce retour rapide,

idéalement il me faudra appliquer la VBA par images, sachant qu'il y en a plus de 1000, je crains que celà ne convienne Florian53

As tu étais faire un tour sur ce post :

https://forum.excel-pratique.com/viewtopic.php?t=84229

Le code de Mferrand me parait adapter à ton problème

Merci pour ce lien, je vais mettre en place sur le fichier , mais il semblerait que celà fonctionne très correctement !

Merci à toit et à Mferrand !!

Résolu

Bonsoir,

Salut Florian53 ! Je ne sais pas ce que j'ai pu dire dans le sujet auquel tu renvoies... (je regarderai ensuite). Mais là il me semblerait judicieux de se simplifier la vie :

Sub ZoomUnzoom()
    Dim img As Shape, nimg$
    nimg = Application.Caller
    Set img = ActiveSheet.Shapes(nimg)
    With img
        If nimg Like "zoom*" Then
            .Name = Replace(.Name, "zoom", "")
            .Width = .Width / 2
        Else
            .Name = "zoom" & .Name
            .Width = .Width * 2
        End If
    End With
End Sub

J'ai retenu 2 car cela fait un grossissement x4. On peut éventuellement rendre le facteur de zoom variable. Et la même procédure zoome et dézoome.

Cordialement.

Re,

idéalement il me faudra appliquer la VBA par images, sachant qu'il y en a plus de 1000

Ça, ce n'est pas vraiment un problème, il suffit d'une petite procédure pour affecter la macro à toutes les shapes (propriété: OnAction) pour rattraper. Et de façon plus pérenne de prévoir de définir la propriété OnAction lors de l'insertion de l'image.

Super, j'ai adopter la seconde proposition de Mferrand et celà fonctionne à merveille sur l'ensemble de mon fichier !

Rechercher des sujets similaires à "zoom image"