Zoom image

Y compris Power BI, Power Query et toute autre question en lien avec Excel
p
preststeph
Jeune membre
Jeune membre
Messages : 38
Inscrit le : 30 novembre 2018
Version d'Excel : 2016

Message par preststeph » 6 décembre 2018, 21:19

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
Zoom.xlsm
(62.04 Kio) Téléchargé 13 fois
Avatar du membre
Florian53
Membre dévoué
Membre dévoué
Messages : 563
Appréciations reçues : 47
Inscrit le : 3 juin 2015
Version d'Excel : Office 365

Message par Florian53 » 6 décembre 2018, 21:28

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
Les grandes réussites sont le fruit de l'apprentissage durable. Apprenez à apprendre chaque jour.

:btres:
p
preststeph
Jeune membre
Jeune membre
Messages : 38
Inscrit le : 30 novembre 2018
Version d'Excel : 2016

Message par preststeph » 6 décembre 2018, 21:32

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
Avatar du membre
Florian53
Membre dévoué
Membre dévoué
Messages : 563
Appréciations reçues : 47
Inscrit le : 3 juin 2015
Version d'Excel : Office 365

Message par Florian53 » 6 décembre 2018, 21:36

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
Les grandes réussites sont le fruit de l'apprentissage durable. Apprenez à apprendre chaque jour.

:btres:
p
preststeph
Jeune membre
Jeune membre
Messages : 38
Inscrit le : 30 novembre 2018
Version d'Excel : 2016

Message par preststeph » 6 décembre 2018, 21:43

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
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 6 décembre 2018, 21:48

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.
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'201
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 6 décembre 2018, 21:58

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.
p
preststeph
Jeune membre
Jeune membre
Messages : 38
Inscrit le : 30 novembre 2018
Version d'Excel : 2016

Message par preststeph » 6 décembre 2018, 22:24

Super, j'ai adopter la seconde proposition de Mferrand et celà fonctionne à merveille sur l'ensemble de mon fichier !
p
preststeph
Jeune membre
Jeune membre
Messages : 38
Inscrit le : 30 novembre 2018
Version d'Excel : 2016

Message par preststeph » 15 mars 2019, 21:09

:btres:
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message
  • Zoom d'une image
    par priatel » 22 octobre 2016, 13:54 » dans Excel - VBA
    3 Réponses
    755 Vues
    Dernier message par LouReeD
    6 décembre 2018, 21:48
  • Rollover, survol image zoom
    par theguilt » 28 septembre 2015, 16:45 » dans Excel - VBA
    23 Réponses
    1496 Vues
    Dernier message par waard
    4 octobre 2015, 10:55
  • Faire un bouton zoom pur une image
    par Clem31140 » 21 mai 2019, 15:50 » dans Excel - VBA
    11 Réponses
    145 Vues
    Dernier message par James007
    24 mai 2019, 13:02
  • macro Zoom
    par jh50160 » 22 septembre 2014, 13:35 » dans Excel - VBA
    8 Réponses
    610 Vues
    Dernier message par jh50160
    23 septembre 2014, 19:31
  • Problème de zoom
    par jfk15 » 6 juin 2015, 17:32 » dans Excel - VBA
    5 Réponses
    328 Vues
    Dernier message par jfk15
    6 juin 2015, 22:48
  • Resolution et zoom Ecran
    par KTM » 11 février 2019, 21:23 » dans Excel - VBA
    4 Réponses
    171 Vues
    Dernier message par KTM
    12 février 2019, 07:03