XL 2016 [VBA] afficher un userform en Mouse Over d'une forme

F22Raptor

XLDnaute Impliqué
Bonjour à tous,
J'ai vu des vidéos qui expliquent comment programmer le déclenchement d'une macro sur un Mouse Over d'une forme dans une feuille Excel.
En fait, si j'ai bien compris, il faut superposer à chaque forme un contrôle ActiveX transparent, et c'est lui qui déclenchera le Mouse Over.

C'est pas trop ce qui m'arrange, vu que ma feuille comprend quelques dizaines de formes, et que l'utilisateur peut en créer de nouvelles.
L'idée étant que le passage en Mouse Over de la forme affiche un UF avec les dimensions de la forme, et qui disparaisse quand on ne survole plus la forme.
S'il faut créer un ActiveX superposé à chaque forme, de sa dimension exacte, et le redimensionner quand on redimensionne la forme, ça risque d'être lourd !

Selon vous, sans cette méthode, c'est impossible d'avoir ce résultat ?
 

Dudu2

XLDnaute Barbatruc
Bonjour,
Si le but est d'afficher les caractéristiques des Shapes, je peux te proposer ce code home made.
Il y a une petite latence due au minimum du Application.OnTime() mais ce n'est pas très sensible.

A noter que si besoin, le code peut être sorti dans un classeur indépendant pour pouvoir être utilisé sur toute feuille de tout classeur que le code demanderait. Je vais peut-être le faire d'ailleurs comme un "outil à Shape".

Fichier supprimé, voir plus loin.
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
Voilà la version généraliste qui est indépendante et demande sur quelle feuille de quel classeur on doit faire la manip.

Tip: on peut arrêter l'analyse soit avec ESC soit en revenant sur le classeur indépendant.

Fichier supprimé, voir plus loin.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour @Dudu2
je te propose mon astuce timer commandbars
qui est plus rapide et qui utilise donc un events commandbars en interne non implémenté
on a donc une boucle VBA non bloquante silencieuse (et non gourmande) pour preuve tu peux même essayer de taper dans les cellules rien ne t’empêche de travailler sur la feuille en meme temps
astuce à la patricktoulon ;)
te reste plus qu'a refaire ton userform
 

Pièces jointes

  • Hover on all object by timer CMBars.xlsm
    189.6 KB · Affichages: 14

Dudu2

XLDnaute Barbatruc
Voici d'abord ma tentative de rendre ton système plus modulaire pour simplifier l'appel au CommandBars Timer. C'est plus facile à utiliser ensuite avec de simples appels de fonctions indépendantes Start & Stop.

J'ai préféré sortir dans un Module_CommandBarsTimer dédié ce que je pouvais du Module ThisWorkbook pour ne pas mélanger avec ce qu'on peut éventuellement y trouver d'autres traitements liés au classeur.
Hélas on ne peut pas sortir la variable WithEvents ni sa fonction liée.
 

Pièces jointes

  • CommandBars Timer.xlsm
    23.7 KB · Affichages: 5

patricktoulon

XLDnaute Barbatruc
heu.. c'est simple
pur demarrer c'est set cmbrs=application.commandbars
pour l'arreter c'est set cmbrs =nothing
je pige pas ton souci tu laisse cici dans le thiswotkbook
VB:
Option Explicit
Private WithEvents Cmbrs As CommandBars    'creation de l'object commandbars events
#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
#Else
    Private Declare Function GetCursorPos Lib "User32" (lpPoint As POINTAPI) As Long
#End If

Private Type POINTAPI: X As Long: Y As Long: End Type
Public t
Dim pos As POINTAPI
Dim obj
'evenement commandbars
Private Sub Cmbrs_OnUpdate()
    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled
    Ontimer Timer - t
End Sub
et dans un module standard
tu déplace aussi les variable global dans le module standard si il faut

et puis voila

non je pige pas ton soucis

VB:
 Sub go(): t = Timer: Set thisworkbook.Cmbrs = Application.CommandBars: End Sub

 Sub alt(): Set thiswokbook.Cmbrs = Nothing: TimerOnStop Timer - t: End Sub

'pseudo events on timer

Sub Ontimer(Optional TimeElapsed As Double)    'action pendant le timer
    [B1] = Format(Now, "hh:nn:ss")
    On Error GoTo fin
    [B2] = Format((TimeElapsed) / 86400, "hh:mm:ss ") & "0" & Left(Split(TimeElapsed & "000", ",")(1), 2)
    GetCursorPos pos
    [B3] = "x=" & pos.X
    [B4] = "y=" & pos.Y
    Set obj = ActiveWindow.RangeFromPoint(pos.X, pos.Y)
    'MsgBox TypeName(obj)
    Select Case TypeName(obj)
    Case "Range"
        [B5] = "Range " & obj.Address: [C5] = ""
    Case Else
        Select Case True
        Case TypeOf obj Is OLEObject
            [B5] = "OLEObject"
            [C5] = obj.Name

        Case ActiveSheet.Shapes(obj.Name).Type = 1    ' si c'est une shape
            [B5] = "shape"
            [C5] = obj.Name

        Case ActiveSheet.Shapes(obj.Name).Type = 8    ' si c'est un control formulaire
            [B5] = "control formulaire"
            [C5] = obj.Name

        Case ActiveSheet.Shapes(obj.Name).Type = 13    ' si c'est une picture
            [B5] = "picture"
            [C5] = obj.Name
        Case ActiveSheet.Shapes(obj.Name).Type = 24    ' si c'est une picture
            [B5] = TypeName(obj)
            [C5] = obj.Name

        Case TypeName(obj) = "ChartObject"
            [B5] = TypeName(obj)
            [C5] = obj.Name

        End Select

    End Select
fin:
    Err.Clear
End Sub

'pseudo events timer stop
Sub TimerOnStop(Optional TimeElapsed As Double = 0)
[B1:C5].ClearContents
' faire quelque chose ici quand on arrete
End Sub
tu a un pseudo event update dans le quel tu fait ce que tu veux
et un etvant stop pour faire ce que tu veux quand tu arrete voir rien si tu veux pas t'en servir
les deux macro associé au bouton de formilaire demarre et arrete c'est tout
c'est pas compliqué tu n'avais qu'a refaire ton usf avec ta table de correspondance de type d'obj
tu veux que je te le fasse ?
 

Dudu2

XLDnaute Barbatruc
Non, je suis en train de le faire en intégrant les 2 méthodes sur simple constante préprocesseur.
On ne peut pas placer la variable Private WithEvents Cmbrs As CommandBars dans un module séparé.
Les variables WithEvents sont spéciales. Donc soit en ThisWorkbook, soit en feuille.
 

patricktoulon

XLDnaute Barbatruc
re
concernant mon timer bars on peut faire très simple
reste plus qu'a remplacer mon select case par ta moulinette type dans le userform
l'userform est non modal
 

Pièces jointes

  • Hover on all object by timer CMBars V 2 .xlsm
    194.1 KB · Affichages: 10

Dudu2

XLDnaute Barbatruc
Voilà le classeur avec les 2 méthodes de Timer possibles: Application.OnTime() et CommandBars Timer.
Une simple variable préprocesseur permet d'activer l'une ou l'autre:
VB:
'------------------------------------
#Const CommandBarsTimerMethod = True    'True 3 fois par seconde et donc plus réactif mais consomme plus de CPU
                                        'False 1 fois par seconde mais suffisant pour la fonctionnalité
'------------------------------------
Maintenant une amélioration qui permet de déplacer le UserForm s'il gène là où il est, pour voir la feuille et les éventuels objets qu'il cache.

Pour info je n'ai pas utilisé la méthode ActiveWindow.RangeFromPoint(Pos.X, Pos.Y) pour trouver l'objet car elle ne permet pas de détecter des objets superposés. J'ai utilisé une fonction perso IsMouseOverObject().

Fichier supprimé, voir ci-dessous
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
315 124
Messages
2 116 472
Membres
112 753
dernier inscrit
PUARAI29