Boite texte en ...survole.

WEIDER · 26 Mars 2016

Bonjour à tous et bon weekend !

Pourriez vous m'aider à résoudre mon problème de boite texte...
Je but dessus depuis ce matin et ne sais pas comment faire.

Tout est dit dans mon fichier joint.

D'avance un grand merci à tous ceux qui voudront bien m'aider.

Amicalement

Weider.

WEIDER · 27 Mars 2016

Re : Boite texte en ...survole.

Je viens de tomber sur ce fichier fait par une personne...

C'est exactement ce que je souhaiterai !!!!!!!

Je pense que c'est un bouton de contrôle Activex.

Problème je ne vois pas comment accéder au message qui s'affiche, pour le modifier par exemple.
Autre chose, peux ton mettre une macro sur ce même bouton ?
Ou
Est il possible de faire la même chose mais sur une simple forme ? Forme à laquelle il serait peut être plus facile d'y coller une macro...

Weider.

Lone-wolf · 27 Mars 2016

Re : Boite texte en ...survole.

WEIDER...

Moi je vais aller me coucher, c'est exactement ce que mon fichier fait Contrôle ActiveX = Image + Shape = Forme xxx; mis à part cette ligne. à remplacer par celle que j'ai mis. Mais le résultat reste le même.

If X < 10 Or X > Image1.Width - 10 Or Y < 10 Or Y > Image1.Height - 10 Then

bonne nuit.

Modeste geedee · 27 Mars 2016

Re : Boite texte en ...survole.

Bonsour®
une seule image, une seule info-survol
2 macros ...

BOISGONTIER · 27 Mars 2016

Re : Boite texte en ...survole.

Bonjour,

Un exemple simple pour afficher des bulles au survol de shapes

http://boisgontierjacques.free.fr/fichiers/Images/ComposantBulles.xls

Code:

Sub bulles2()
  For Each s In ActiveSheet.Shapes
    If s.Type <> 8 Then
      ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
      tmp = s.Name
      bulle = Application.VLookup(tmp, [légendes], 2, False)
      If Not IsError(bulle) Then
         s.Hyperlink.ScreenTip = bulle & Chr(10) & "...."
      Else
         s.Hyperlink.ScreenTip = "...."
      End If
    End If
  Next s
End Sub

JB

WEIDER · 27 Mars 2016

Re : Boite texte en ...survole.

Bonsoir BOISGONTIER, merci beaucoup pour tes exemples, je vais les regarder en détail.

De mon coté j'avance, mais pour répéter la chose, je sais po faire :-(

Merci pour votre aide.

WEIDER · 27 Mars 2016

Re : Boite texte en ...survole.

Merci à tous pour tous vos conseils avisés et vos solutions, je vais en tenir compte et je me les garde précieusement !

Avec toutes les possibilités que vous m'avez donné, je vais essayer d'avancer.

Merci encore à tous !

Weider.

WEIDER · 3 Avril 2016

Re : Boite texte en ...survole.

Bonjour à tous,

Je me permets de ré-ouvrir ce fil temporairement car j'ai un petit souci sur mon fichier (pièce jointe)
Je mets également une vidéo pour illustrer la chose.

Lorsque je clic sur mes différents classeur sur mon premier onglet cela fonctionne bien, ensuite j’accède sur les différentes pages des onglets, MAIS là je n'est pas la main tout de suite sur la sélection des cellules !?
Le temps est aléatoire mais il faut que j’attende quelques secondes avant de pouvoir sélectionner des cellules...
Sur ma vidéo, on entends mes clic de souris, mais impossible de sélectionner une cellule.

L'opération peut être répétée si je retourne saisir un classeur........

Avez vous une idée ?!

Merci à vous !

Weider.

Fichier Excel (il faut l'ouvrir dans l'application Excel, l'option est en haut...)
https://www.dropbox.com/s/ab43d7m107elf2v/Test.xlsm?dl=0

Vidéo
https://www.dropbox.com/s/ex5apgmhbism6hc/Vidéo.mp4?dl=0

Lone-wolf · 3 Avril 2016

Re : Boite texte en ...survole.

Bonjour WEIDER,

j'ai retouché le classeur en enlevants les Do Events inutiles, j'ai supprimer les liens Hypertexts, mais j'ai fait d'une autre façon pour que tu puisse acceder à la page principale.

FICHIER

WEIDER · 3 Avril 2016

Re : Boite texte en ...survole.

Hé bonjour Lone-wolf !

J'ai eu des soucis pour accéder au site CJOINT, obligé de passer par le Mac de mon fils... Vas comprendre, sur mon PC ça moulinait sans rien afficher...

Bref, après avoir récupéré le fichier sur lequel tu as fait quelques modifications, bein.... J'ai toujours mes soucis !
Je viens de te faire une mini vidéo pour que tu te rende compte du problème.

https://www.dropbox.com/s/6vksgisdxuhdmfj/Film.mp4?dl=0

Merci pour ton aide !

Weider.

Si... · 3 Avril 2016

Re : Boite texte en ...survole.

salut

Pour savoir si cela vient de ton classeur*, dans le dernier fichier, garde seulement ceci (page de code de l’onglet Menu)

VB:

Dim W As Single, H As Single, pos As Integer
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  On Error Resume Next
  ActiveSheet.Shapes("chem").Visible = 0
  W = ActiveSheet.Shapes("image1").Width - 8
  H = ActiveSheet.Shapes("image1").Height - 8
  If Y >= 8 And Y <= H And X >= 8 And X <= W Then
     ActiveSheet.Shapes("chem").Visible = 1
    pos = Application.Match(X, Array(0, 107, 214, 321, 428, 535, 642, 749, 856), 1)
    ActiveSheet.Shapes("chem").TextFrame.Characters.Text = WorksheetFunction.Index([lestitres], pos, 1)
  End If
End Sub
Sub Image1_Click()
  Application.Goto Sheets("Classeur" & pos).[A1]
End Sub

Et dis-nous.
Nota : j’ai réduit l’image pour alléger mon fichier et cela peut donner un petit ralentissement (de mouvements : coordonnées pas mises à jour).

* pour une fois ma version 2010 n'a pas connu les désagréments que tu cites alors qu’elle coince avec de nombreuses autres propositions (messages d’erreurs en veux-tu en voilà dans le déroulement des macros).

Lone-wolf · 3 Avril 2016

Re : Boite texte en ...survole.

Hello Si...

Si... · 3 Avril 2016

Re : Boite texte en ...survole.

Hola Lone-wolf

No hablo inglés sino lo entiendo un poquito (vba obliga).

Hasta la vista Lobo !

WEIDER · 3 Avril 2016

Re : Boite texte en ...survole.

Bonjour Si...

Et bien écoute, je pense que le fait d'avoir modifié le code en profondeur lui à fait le plus grand bien car je n'ai plus aucun 'blocage' !!!!!!!!!!
Tu es un champion SI... !
Comme tu me l'as conseillé, j'ai déjà changé rien que mon code avec le tiens avant de prendre ton fichier final, et là force a été de constater que hooooo miracle, ça ne bloque plus !

A présent, dire ce qui n'allait pas dans ce foutu code avant ton intervention, ça, toi seul peut me le dire, car moi pour moi tout ceci n'est que sorcellerie ;-)

Mille mercis Si... et toi aussi Lone-wolf.

Bon et beau dimanche à vous deux (super ensoleillé sur Orléans)

Amicalement

Weider.

Lone-wolf · 3 Avril 2016

Re : Boite texte en ...survole.

Yo tambien ablo un poquito l'español

Mas falo melhor o português, rapaz

Hasta luego Gringo!

Modeste geedee · 3 Avril 2016

Re : Boite texte en ...survole.

Bonsour®

Si... à dit:
Nota : cela peut donner un petit ralentissement (de mouvements : coordonées pas mises à jour).

Bien vu, en supprimant la proc MouseDown tu as solutionné le fait que celle-ci gardait le focus ... !! ??

en effet ,reste à voir le masquage de la shape("Chem") lorsque le mouvement de souris en bordure de l'image est trop rapide celle-ci reste affichée malgré le gap utilisé en bordure W ( X >=gap, X<(W-gap)

code modifié pour simplifier adaptabilité :
Code VB:
Public pos As Integer
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim W As Single, H As Single, Gap as integer
' ---------nombre de Tranches sensibles dans l'image
Dim NbTr As Integer
NbTr = 8
'--------adapter pour améliorer le controle de souris à l'interieur de l'image-----
Gap=15
'-----------------------------------------------------
On Error Resume Next
ActiveSheet.Shapes("chem").Visible = 0
W = ActiveSheet.Shapes("image1").Width
H = ActiveSheet.Shapes("image1").Height
'------------------------------------
If Y >= Gap And Y <= (H - Gap) And X >= Gap And X <= (W - Gap) Then
ActiveSheet.Shapes("chem").Visible = 1
pos = 1 + Int(X / (W / NbTr))
ActiveSheet.Shapes("chem").TextFrame.Characters.Text = WorksheetFunction.Index([lestitres], pos, 1)
Application.StatusBar = "X : " & X & " Y : " & Y & " Classeur : " & pos
Else
ActiveSheet.Shapes("chem").Visible = 0
End If
End Sub
Sub Image1_Click()
ActiveSheet.Shapes("chem").Visible = 0
Application.Goto Sheets("Classeur" & pos).[A1]
End Sub

Boite texte en ...survole.

WEIDER

XLDnaute Impliqué

Pièces jointes

WEIDER

XLDnaute Impliqué

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Pièces jointes

BOISGONTIER

XLDnaute Barbatruc

WEIDER

XLDnaute Impliqué

Pièces jointes

WEIDER

XLDnaute Impliqué

WEIDER

XLDnaute Impliqué

Lone-wolf

XLDnaute Barbatruc

WEIDER

XLDnaute Impliqué

Si...

XLDnaute Barbatruc

Pièces jointes

Lone-wolf

XLDnaute Barbatruc

Si...

XLDnaute Barbatruc

WEIDER

XLDnaute Impliqué

Lone-wolf

XLDnaute Barbatruc

Modeste geedee

XLDnaute Barbatruc

Discussions similaires