Boite texte en ...survole.

W

WEIDER

XLDnaute Impliqué

• 27 Mars 2016

• #16

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.

 

Pièces jointes

• C'est ça.xlsm

  20.6 KB · Affichages: 58

Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc

• 27 Mars 2016

• #17

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. 😎

 

Dernière édition: 27 Mars 2016

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 27 Mars 2016

• #18

Re : Boite texte en ...survole.

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

 

Pièces jointes

• Capture.JPG

  46 KB · Affichages: 41
• Classeur1 (3).xlsm

  119.9 KB · Affichages: 62
• Classeur1 (3).xlsm

  119.9 KB · Affichages: 58

Vote positif 0 Vote négatif

BOISGONTIER

XLDnaute Barbatruc

Repose en paix

• 27 Mars 2016

• #19

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

 

Dernière édition: 27 Mars 2016

Vote positif 0 Vote négatif

W

WEIDER

XLDnaute Impliqué

• 27 Mars 2016

• #20

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.

 

Pièces jointes

• Nouveau test 2.xlsm

  113.5 KB · Affichages: 33

Dernière édition: 27 Mars 2016

Vote positif 0 Vote négatif

W

WEIDER

XLDnaute Impliqué

• 27 Mars 2016

• #21

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.

 

Vote positif 0 Vote négatif

W

WEIDER

XLDnaute Impliqué

• 3 Avril 2016

• #22

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

 

Dernière édition: 3 Avril 2016

Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc

• 3 Avril 2016

• #23

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

 

Vote positif 0 Vote négatif

W

WEIDER

XLDnaute Impliqué

• 3 Avril 2016

• #24

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.

 

Dernière édition: 3 Avril 2016

Vote positif 0 Vote négatif

S

Si...

XLDnaute Barbatruc

• 3 Avril 2016

• #25

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).

 

Pièces jointes

• Image vers Onglet.xlsm

  328.9 KB · Affichages: 32

Dernière édition: 3 Avril 2016

Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc

• 3 Avril 2016

• #26

Re : Boite texte en ...survole.

Hello Si... 🙂

 

Vote positif 0 Vote négatif

S

Si...

XLDnaute Barbatruc

• 3 Avril 2016

• #27

Re : Boite texte en ...survole.

Hola Lone-wolf

No hablo inglés sino lo entiendo un poquito (vba obliga).😀
Hasta la vista Lobo !😀

 

Vote positif 0 Vote négatif

W

WEIDER

XLDnaute Impliqué

• 3 Avril 2016

• #28

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.

 

Vote positif 0 Vote négatif

Lone-wolf

XLDnaute Barbatruc

• 3 Avril 2016

• #29

Re : Boite texte en ...survole.

Yo tambien ablo un poquito l'español

Mas falo melhor o português, rapaz 😉


Hasta luego Gringo! 😉

 

Dernière édition: 3 Avril 2016

Vote positif 0 Vote négatif

Modeste geedee

XLDnaute Barbatruc

• 3 Avril 2016

• #30

Re : Boite texte en ...survole.

Bonsour®

Si... à dit:

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

Cliquez pour agrandir...

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

 

Vote positif 0 Vote négatif