Rollover, survol image zoom

Bonjour, quelqu'un a déjà réussi a faire un zoom sur une image juste en la survolant mais sans utiliser "insertion commentaire"?

Merci

Bonsoir,

fichier joint à voir... Attention c'est trouvé sur le net !!!

Sur chaque image de la feuille, faire un clic droit et attribuer la macro : ZoomUnZoomImage

@ bientôt

LouReeD

253zoom.xlsm (60.96 Ko)

Ah merci, après ca serait plus pour une Image (control active x)

avec juste le survol de celle_ ci qui grossi et réduit de façon fluide

Je sais pas si je suis clair dans mes explications

Merci

Alors là il faudrait en parler aux pro du forum !!!

Bon courage

@ bientôt

LouReeD

ca donnerai un super rendu non?

et si des pros vous répondent, il pourrait y avoir un système de zoom type loupe Windows...

Oui en effet cela ferait un jolie effet.

Mais pourquoi faire ?

@ bientôt

LouReeD

Hello,

Oui pour quoi faire ? Car en fonction de l'utilité, mieux vaudrait passer par un autre logiciel et un autre langage.

Sinon pour faire suite au topic : Teste au survol d'une icones.

En dehors de mon problème sur l'utilisation de X,Y, j'ai réussis à faire plus fluide, par contre quand le zoom est rapide, il est difficile d'ouvrir le lien hypertexte...

Du coup, essaye de jouer sur les placements de ces 3 lignes, si tu trouve l'idéale :

Application.EnableEvents = False 'Pour désactiver les événements feuille

ThisWorkbook.Worksheets(1).logo.Visible = False 'Pour désafficher le logo, pour un micro survol, déclenchant le zoom

Application.ScreenUpdating = False 'Pour désafficher le raffraichissement écran, pour accélérer le traitement et ...

La meilleure solution intermédiaire que j'ai trouvé, c'est ça, par contre il faut un triple clic pour ouvrir le lien, ou faire un clic en mouvement pendant que le sablier micro-tourne :

Private Sub logo_Click()
Dim MemoireTailleIconeWidth As Integer
Dim MemoireTailleIconeHeight As Integer
Dim MemoireEmplacementIconeTop As Integer
Dim MemoireEmplacementIconeLeft As Integer
MemoireTailleIconeWidth = 80 'taille en point
MemoireTailleIconeHeight = 80
MemoireEmplacementIconeTop = ThisWorkbook.Worksheets(1).Shapes("logo").Top
MemoireEmplacementIconeLeft = ThisWorkbook.Worksheets(1).Shapes("logo").Left

  Application.EnableEvents = False 'Pour permettre d'éviter événement mousemove annulant l'ouverture du fichier quand l'icone va reprendre sa taille initiale
  Application.ScreenUpdating = False 'Déraffraichissement pour essayer de rendre l'opération plus rapide et pour essayer d'éviter 36 zooms à la suite des micros mouvement souris
  'ThisWorkbook.Worksheets(1).logo.Visible = False 'Désafiche controle pour essayer d'éviter 36 zooms à la suite des micros mouvement souris

On Error Resume Next

ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte 4")).Visible = False
ThisWorkbook.Worksheets(1).Shapes("logo").Width = MemoireTailleIconeWidth
ThisWorkbook.Worksheets(1).Shapes("logo").Height = MemoireTailleIconeWidth
ThisWorkbook.Worksheets(1).Shapes("logo").Left = MemoireEmplacementIconeLeft
ThisWorkbook.Worksheets(1).Shapes("logo").Top = MemoireEmplacementIconeTop
  'ThisWorkbook.Worksheets(1).logo.Visible = True 'Désafiche controle pour essayer d'éviter 36 zooms à la suite des micros mouvement souris
Application.ScreenUpdating = True 'Déraffraichissement pour essayer de rendre l'opération plus rapide et pour essayer d'éviter 36 zooms à la suite des micros mouvement souris
Application.EnableEvents = True 'Pour permettre d'éviter événement mousemove annulant l'ouverture du fichier quand l'icone va reprendre sa taille initiale
Workbooks.Open ("C:\Users\waard\Desktop\Inventaires 2015")

End Sub

Private Sub logo_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim MemoireTailleIconeWidth As Integer
Dim MemoireTailleIconeHeight As Integer
Dim MemoireEmplacementIconeTop As Integer
Dim MemoireEmplacementIconeLeft As Integer
MemoireTailleIconeWidth = 80 'taille en point
MemoireTailleIconeHeight = 80
MemoireEmplacementIconeTop = ThisWorkbook.Worksheets(1).Shapes("logo").Top
MemoireEmplacementIconeLeft = ThisWorkbook.Worksheets(1).Shapes("logo").Left
'Pour obtenir la conversion Point > cm > Point // => Multiplier par CM x coef 28.36 //// exemple 2.82cm x 28.36 = 80 //// exemple 5.29 x 28.36 = 150

  Application.EnableEvents = False 'Désactivation événements feuille, pour essayer d'éviter 36 zooms à la suite des micros mouvement souris
  ThisWorkbook.Worksheets(1).logo.Visible = False 'Désafiche controle pour essayer d'éviter 36 zooms à la suite des micros mouvement souris
  Application.ScreenUpdating = False 'Déraffraichissement pour essayer de rendre l'opération plus rapide et pour essayer d'éviter 36 zooms à la suite des micros mouvement souris

  On Error Resume Next

   If X < 20 Or X > logo.Width - 1 Or Y < 20 Or Y > logo.Height - 1 Then 'A voir comment fonctionne X, Y pour améliorer fluidité  // X, Y Position horizontale ou verticale, mesurée en points, depuis le bord gauche ou supérieure du contrôle.
       ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte 4")).Visible = False
       ThisWorkbook.Worksheets(1).Shapes("logo").Width = MemoireTailleIconeWidth
       ThisWorkbook.Worksheets(1).Shapes("logo").Height = MemoireTailleIconeWidth
       ThisWorkbook.Worksheets(1).Shapes("logo").Left = MemoireEmplacementIconeLeft
       ThisWorkbook.Worksheets(1).Shapes("logo").Top = MemoireEmplacementIconeTop
ThisWorkbook.Worksheets(1).logo.Visible = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Else
    ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte 4")).Visible = True
    ThisWorkbook.Worksheets(1).Shapes("logo").Width = 150
    ThisWorkbook.Worksheets(1).Shapes("logo").Height = 150
    ThisWorkbook.Worksheets(1).Shapes("logo").Left = MemoireEmplacementIconeLeft
    ThisWorkbook.Worksheets(1).Shapes("logo").Top = MemoireEmplacementIconeTop
ThisWorkbook.Worksheets(1).logo.Visible = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End If

End Sub

Sinon sur MrExcel, quelqu'un a créer une Dll avec de nouveaux événements qui semble pas mal, pour répondre à ce problème et d'autres, mais impossible de le faire fonctionner, je ne sais pas, si quelqu'un arrive à le faire fonctionner WS Mouse Events :

http://www.mrexcel.com/forum/excel-questions/434593-help-mousemove-events-activex-controls-worksheet.html

Même avec le fichier Dll importé dans les références, ça ne fonctionne pas, le code plante dès le départ, pour non reconnaissance de l'événement ?!

Là je suis perdu....

Désolé...

LouReeD

Bonjour,

un essai en utilisant l'événement MouseMove.

Dézoome lorsque tu sors de l'image. Ne le fait pas si tu en sors très vite. Retourner dessus et en ressortir plus tranquillement pour dézoomer.

eric

Hello Eriiic,

Super boulot ,

J'ai édité mon dernier post sur le topic : "Teste au survol d'une icones" pour indiquer ta meilleure réponse, inutile que j'encombre les archives du forum avec ma solution.

Bonjour, c'est pas mal,

mais chez moi ça fait des truc bizarre, l'image change de fond et un contour apparait

Bonsoir,

une petite variation...

@ bientôt

LouReeD

Hello tout le Monde,

@Theguilt Moi j'ai Vista / Excel 2010, no soucis.

Bye

Bonjour à tous,

Je viens de tester ton fichier, pas de truc bizarre non plus.

eric

Ah excusez-moi j'y sui arrivé, juste une petite question, Pourquoi il est difficile de temps en temps de quitter l'image pour quelle revienne comme avant? y'a t'il une ligne ou on peut agir dessus?

Un grand merci

Bonjour,

sans doute que windows est occupé à d'autres tâches régulièrement et mousemove rate quelques relevés.

J'ai essayé d'ajouter DoEvents mais ça ne change rien.

Ca sera difficile de faire mieux avec cette méthode, une fois la souris en dehors de l'image plus aucun événement n'est généré.

On pourrait ajouter le dézoomage sur une sélection de cellule.

eric

Le dézoomage sur une selection de cellule.? Mais c'est une image (contrôle active x)

Hello,

Regarde le fichier que je t'ai bidouillé rapidement, étant donné que VBA n'a pas d'événement "souris quitte bouton"

J'ai combiné ton image ctrleactivex à zoomer avec une 2e image ctrleactivex (en rouge mais qui peut être transparente), je les ais groupé en 1 seul objet.

Du coup quand tu rentre dans l'image2 en rouge, ça permet de créer cet événement "souris quitte bouton" (qui est en fait souris rentre dans l'image qui sert de test pour le dézoomage), quand tu zoom et que ton curseur entre dans la zone de la 2e image ça dézoome, sauf si tu va vite dans ce cas il faut rerentrer dans l'image2 pour dézoomer, mais ça semble bien marcher.

C'est pas très propre, c'est optimisable, je te laisse les améliorations, là j'ai les doigts gelés.

Bye

Vraiment parfait je te remercie c'est top!!

Merci pour le temps passé

Par contre j'ai un petit souci je l'ai copier sur un autre fichier j'ai un petit problème, il y a un truc que j'ai mal du coller non?

8classeur1.xlsm (54.55 Ko)

Oui, il n'y a plus qu'une image toute simple, là où il y'avait 2 contrôles images activex.

Rechercher des sujets similaires à "rollover survol image zoom"