Zoom image

Y compris Power BI, Power Query et toute autre question en lien avec Excel
p
preststeph
Jeune membre
Jeune membre
Messages : 36
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é 11 fois
Avatar du membre
Florian53
Membre fidèle
Membre fidèle
Messages : 452
Appréciations reçues : 31
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 : 36
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 fidèle
Membre fidèle
Messages : 452
Appréciations reçues : 31
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 : 36
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'203
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'203
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 : 36
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 : 36
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