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 ?!