Teste au survol d'une icones

Le 29/09/2015 à 01:57

C'est vraiment top

Par contre mon icone servait de lien hypertexte avant donc j'ai voulu le rajouter comme ceci:

Private Sub Image1_Click()

Workbooks.Open "chemin de mon fichier"

End Sub

Mais ca ne fonctionne pas

Le 29/09/2015 à 02:34

j'ai cette ligne en erreur:

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

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

ActiveSheet.Shapes.Range(Array("ZoneTexte4")).Visible = False

Else

ActiveSheet.Shapes.Range(Array("ZoneTexte4")).Visible

End If

End Sub

Private Sub Image1_Click()

Workbooks.Open "chemin_acces.XLS"

End Sub

Le 29/09/2015 à 10:51

Hi,

Ton erreur est normale, après visible, il faut une commande soit = true (affiche oui) soit = false (affiche non)

Cjoint plante, pas de PJ, voilà le code que tu dois appliquer :

Private Sub logo_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

  If X < 10 Or X > logo.Width - 10 Or Y < 10 Or Y > logo.Height - 10 Then
    ActiveSheet.Shapes.Range(Array("ZoneTexte 4")).Visible = False
  Else
    ActiveSheet.Shapes.Range(Array("ZoneTexte 4")).Visible = True
  End If
End Sub

Private Sub logo_Click()
ActiveSheet.Shapes.Range(Array("ZoneTexte 4")).Visible = False 'Enlève l'affichage du texte, sinon reste affiché
Workbooks.Open ("C:\Users\waard\Desktop\Edg 3t2015 CMC") 'voilà l'exemple de chemin à appliquer, ici pas besoin de .xlsm, juste le nom
End Sub
Le 29/09/2015 à 23:45

C'est top , tu me rends un grand service, par contre, ca marche bien pour les raccourci sur le C mais quand l'emplacement est dans un disque réseau j'ai cette ligne en défaut:

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

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

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

Else

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = True

End If

End Sub

Private Sub image2_Click()

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

Workbooks.Open ("G:\........")

End Sub

C'est bizarre

Le 30/09/2015 à 11:54

A part une mauvaise identification de la nature du problème, je ne vois pas pourquoi ça plante sur ta ligne en rouge ??.... J'ai essayé en utilisant pour réseau mon réseau USB, débranché, branché, RAS, le seul problème qu'il y'aurait pu avoir est sur l'ouverture du lien, à cause des lettres réseau, qui peuvent changer d'un poste à l'autre, ce qui plante le chemin d'accès, mais là ?

Essaye ça (fixation du code sur le classeur utilisé) :

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X < 10 Or X > Image2.Width - 10 Or Y < 10 Or Y > Image2.Height - 10 Then
ThisWorkbook.ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False
Else
ThisWorkbook.ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = True
End If
End Sub

Private Sub image2_Click()
ThisWorkbook.ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False
Workbooks.Open ("I:\Controles sites secondaires Saone")
End Sub

Sinon peut être qu'en fixant sur la feuille que tu utilise, au lieu d'ActiveSheet (feuille active), tu met en dur Worksheet(1) (1 pour feuille1, 2 pour feuille2,.... tu vois la suite, c'est le numéro de la feuille où se trouve la textbox en cause) :

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X < 10 Or X > Image2.Width - 10 Or Y < 10 Or Y > Image2.Height - 10 Then
ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False
Else
ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = True
End If
End Sub

Private Sub image2_Click()
ThisWorkbook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False
Workbooks.Open ("I:\Controles sites secondaires Saone")
End Sub

Si plante toujours, on va essayer le forcing, c'est pas très élégant, mais au bout d'un moment, faut foncer pour ouvrir une brèche :

> Ici si erreur, pas d'arrêt, passe la ligne en erreur jusqu'à terminer la sub, pas de soucis après ta ligne en erreur, la sub est terminée normalement, donc ça fixera peut être le fonctionnement, à un fonctionnement normale quoi qu'il arrive.

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next 'si erreur passe

> Ici, si t'a une erreur, sur le désaffichage du message il ira directement à l'ouverture du fichier, si l'ouverture du fichier plante, au lieu d'un message, il passe la ligne et atterit à end sub > fin, donc pas d'ouverture de fichier, mais pas d'erreur (à cause du chemin faux).

Private Sub image2_Click()
On Error Resume Next 'si erreur passe
Le 30/09/2015 à 20:03

oh merci je fais l'essai vendredi.

Tu crois que c'est possible de faire petit agrandissement de l'icône quand tu le survoles et le remettre a la taille normale en le quittant et que se soit fluide?

Apres ça sur vraiment top avec un super rendu

Le 01/10/2015 à 11:11

Edit: Voir réponse d'Eriiic dont le code est meilleur, sur le topic :

https://forum.excel-pratique.com/excel/rollover-survol-inmage-zoom-t68952.html

Le 14/10/2015 à 23:10

Bonjour, j'ai toujours mon souci:

Qui a t'il de bizarre dans mon code?

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

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

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

Else

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = True

End If

End Sub

Private Sub image2_Click()

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

On Error GoTo errorHandler2

Workbooks.Open ("G:.........................")

On Error GoTo 0

Exit Sub

errorHandler2: MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."

Resume Next

End Sub

Le 15/10/2015 à 07:02

Bonjour,

Sub bulles()
  For Each s In ActiveSheet.Shapes
   If s.Type = 13 Or s.Type = 12 Then
     ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
     s.Hyperlink.ScreenTip = s.Name
   End If
  Next s
End Sub

Survol d'un bouton ActiveX

Sub HyperLienBoutonActiveX()
  Set s = ActiveSheet.Shapes(MonBouton")
  ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
  s.Hyperlink.ScreenTip = "coucou au survol"
End Sub

http://boisgontierjacques.free.fr/pages_site/evenements.htm#MouseMove

Ceuzin

24essai-info-bulle.zip (22.44 Ko)
28composantbulles.zip (23.71 Ko)
Le 15/10/2015 à 09:59

Hello,

Si tu tourne sur Mac, il y'a des incompatibilités, sans Mac moi je ne peux pas aider.

Tu peux voir le site de RonBruin http://www.rondebruin.nl/mac.htmou peut être essayé ça :

mybook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = True
Le 15/10/2015 à 23:09

non la je travaille sur Windows:

toujours le même problème

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

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

mybook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False

Else

mybook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = True

End If

End Sub

Private Sub image2_Click()

mybook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False

On Error GoTo errorHandler2

Workbooks.Open ("G:......")

On Error GoTo 0

Exit Sub

errorHandler2: MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."

Resume Next

End Sub

Le 15/10/2015 à 23:56

Re:

Oulah tu t’emmêle tout là, arrête la prog pour ce soir t'est exténué.

Code que je t'ai proposé pour tester uniquement sur mac, sur windows ça plante car c'est incompatible, tu ne peux pas programmer sur windows pour mac et l'inverse aussi, il y'a plein d'incompatibilités qui demandent à reprendre des codes spécifiques pour mac.

mybook.Worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False

Ce code-ci marche uniquement sur windows et pas sur mac :

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

Tu peux en faire une variante thisworkbook.worksheets(1).Shapes.Range(Array("ZoneTexte25")).Visible = False

Il faut toujours que ton objet texte dans le classeur : "ZoneTexte25" porte le même nom dans vba : "ZoneTexte25", chez moi ça marche.

Dit moi si t'a toujours un problème, sur quel OS windows ou mac t'a planté, envoi sur le topic le classeur où ton objet et ton code bloque et je regarderais, chez moi, moi je n'ai pas eu de problème.

Le 17/10/2015 à 01:15

Bonjour, non la je travaille sur Windows

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

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

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

Else

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = True

End If

End Sub

Private Sub image2_Click()

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

On Error GoTo errorHandler2

Workbooks.Open ("C..........")

On Error GoTo 0

Exit Sub

errorHandler2: MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."

Resume Next

End Sub

fonctionne très bien mais si je change le lien par Workbooks.Open ("G........")

Ca ne fonctionne plus

Ceci est mon code définitif qui ne fonctionne pas toujours sur un disque réseau

Private Sub Image2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 On Error GoTo errorHandler2
 If X < 10 Or X > Image1.Width - 10 Or Y < 10 Or Y > Image1.Height - 10 Then
    ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False
  Else
    ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = True
  End If
  On Error GoTo 0
Exit Sub
errorHandler2: MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."
Resume Next
End Sub
Private Sub image2_Click()
ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False
On Error GoTo errorHandler2
Workbooks.Open ("G...")
On Error GoTo 0
Exit Sub
errorHandler2: MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."
Resume Next
End Sub
Le 17/10/2015 à 11:46

Hello,

J'ai trouvé ton problème de zoom, ça vient du fait que ta procédure test sur image2 Image2_MouseMove et qu'ensuite tu teste sur image1 Image1.Width, ça entraine un bug, bien faire attention à ce que ton code reprenne bien les bon objets au bon nom.

capture 2

Pour ton problème d'ouverture, essaye le code ci-dessous, s'il n'y a que la racine répertoire qui pose problème, tu lance l'ouverture sur les 24 possibilités de racine disque, si le fichier n'est pas ouvert alors ça fait un message d'information à l'utilisateur :

Private Sub Image2_Click()
Dim Wb As Excel.Workbook
Dim Appli As Excel.Application
Dim test_classeur_ouvert As Boolean
test_classeur_ouvert = False

ActiveSheet.Shapes.Range(Array("ZoneTexte25")).Visible = False

On Error Resume Next
Set Appli = GetObject(, "Excel.Application")

'ouverture classeur
Workbooks.Open ("A:\Etats des sites secondaire 2015")
Workbooks.Open ("B:\Etats des sites secondaire 2015")
Workbooks.Open ("C:\Etats des sites secondaire 2015")
Workbooks.Open ("D:\Etats des sites secondaire 2015")
Workbooks.Open ("E:\Etats des sites secondaire 2015")
Workbooks.Open ("F:\Etats des sites secondaire 2015")
Workbooks.Open ("G:\Etats des sites secondaire 2015")
Workbooks.Open ("H:\Etats des sites secondaire 2015")
Workbooks.Open ("I:\Etats des sites secondaire 2015")
Workbooks.Open ("J:\Etats des sites secondaire 2015")
Workbooks.Open ("K:\Etats des sites secondaire 2015")
Workbooks.Open ("L:\Etats des sites secondaire 2015")
Workbooks.Open ("M:\Etats des sites secondaire 2015")
Workbooks.Open ("N:\Etats des sites secondaire 2015")
Workbooks.Open ("O:\Etats des sites secondaire 2015")
Workbooks.Open ("P:\Etats des sites secondaire 2015")
Workbooks.Open ("Q:\Etats des sites secondaire 2015")
Workbooks.Open ("R:\Etats des sites secondaire 2015")
Workbooks.Open ("S:\Etats des sites secondaire 2015")
Workbooks.Open ("T:\Etats des sites secondaire 2015")
Workbooks.Open ("U:\Etats des sites secondaire 2015")
Workbooks.Open ("V:\Etats des sites secondaire 2015")
Workbooks.Open ("X:\Etats des sites secondaire 2015")
Workbooks.Open ("Y:\Etats des sites secondaire 2015")
Workbooks.Open ("Z:\Etats des sites secondaire 2015")

'Recherche si nom classeur ouvert
For Each Wb In Appli.Workbooks
If Wb.Name = "Etats des sites secondaire 2015.xlsx" Then
test_classeur_ouvert = True
End If
Next Wb

'Si test d'ouverture classeur dit que non alors message d'avertissement à user
If test_classeur_ouvert = False Then
MsgBox "Attention !!! Vous ne pouvez pas ouvrir ce lien depuis ce poste."
Exit Sub
End If

End Sub

Bien faire attention que le nom soit bien retranscrit et que qu'à cette ligne Wb.Name = "Etats des sites secondaire 2015.xlsx" tu applique bien la bonne racine fichier, sinon plante le contrôle nom.

26copie-de-copie-de-copie-de-zoom-rollover-image-modif-waard.xlsm (24.65 Ko)
Le 19/10/2015 à 20:00

Bonjour, je ne comprends pas trop le code, ou dois-je mettre mon liens du document?

Merci

Le 19/10/2015 à 20:28

Ce code réponds à un problème de chemin identique sauf lettre lecteur.

Si par exemple le chemin bureau pour prendre le fichier "Etats des sites secondaire 2015" se trouve sur la lettre A sur un poste.

Et que le chemin bureau pour prendre le fichier "Etats des sites secondaire 2015" se trouve sur la lettre B sur un autre poste.

Là le code teste sur les 24 lettres de l'alphabet, mais si tu n'a qu'à tester sur 2 type de lettre de lecteur disque, tu peux limiter les lignes de chemin à tester à 2.

Donc à la place du code en rouge, tu met tout ton chemin d’accès, nom fichier inclus, mais sans la partie lettre de disque :

Workbooks.Open ("A:\Etats des sites secondaire 2015")

Exemple ton fichier Morgan excel sans racine la fichier, se trouve dans le chemin C:\User\blabla\morgan, on garde ce qui est en gras et on y colle après la lettre disque alors :

Workbooks.Open ("A:\User\blabla\morgan")

Workbooks.Open ("B:\User\blabla\morgan")

Par contre à cette ligne c'est différent, il s'agit de tester si un classeur au nom du fichier en théorie ouvert, est ouvert, donc :

If Wb.Name = "Etats des sites secondaire 2015.xlsx" Then

Il te faut le nom de ton fichier seul, comprenant la racine du type fichier, xls ou xlsx ou xlsm ou ...

Rechercher des sujets similaires à "teste survol icones"