Changer la couleur quand on clic sur Rectangleàcoinsarrondis16_Clic

Bonjour LouReed,

j'ai essayé à nouveau votre code avec une petite modif.

par contre le texte s'arrête au doubleclic mais dés que je clic sur OK il reprend la lecture

c'est peut-être ce code?

  Application.EnableCancelKey = xlErrorHandler
mais avec la touche "Echap" ça fonctionne

Sub test()
' on active la gestion d'erreur avec renvoi vers la lecture de fin
    On Error GoTo ArrêtLecture
    ' on active la gestion d'arrêt de la lecture avec renvoi en gestion d'erreur
    Application.EnableCancelKey = xlErrorHandler
    ' on prévient que l'on peut arrêter la lecture avec un double clic
    Application.Speech.Speak "Faites un double clic pour arrêter le texte parlé "
    ' on initialise la deuxième lecture
    Application.Speech.Speak "Bonjour, " _
    & "J'ai ajouté des textes 'parlés' dans un excel, " _
    & "pour expliquer -par exemple- pourquoi un champ est mal saisi." _
    & "Je souhaiterai, dans le cas ou le texte parlé est trop long pouvoir l'interrompre" _
    & "et continuer la suite de ma macro." _
    & "Connaitriez-vous une commande qui permette cela ?" _
    & " Merci d'avance."
    ' on a fini de lire on quitte la procédure
    Exit Sub
' si le double clic alors on arrive ici
ArrêtLecture:
    'Application.Speech.Speak Purge:=True' ----> ça ne fonctionne pas avec ce code
    'Application.Speech.Speak , , , Purge' ----> ça ne fonctionne pas avec ce code
'Application.Speech.Speak "Vous avez stoppé la lecture !"' ----> ça ne fonctionne pas avec ce code
    If Err.Number <> 0 Then MsgBox "Erreur " & Err.Number & vbLf & Err.Description 

End Sub

il m'indique cette erreur:

Erreur 50290 :

La méthode 'EnableCancelKey' de l'objet'_Application' a échoué

@bientôt

Bonsoir,

mettez ceci :

' si le double clic alors on arrive ici
ArrêtLecture:
    ' on prévient que la lecture à été arrêtée
    Application.Speech.Speak " "

En fait on change le texte lu par un autre texte lu mais qui est égale à rien (un espace),

et toujours le code pour la détection du double clic :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' on gère le double clic
    Cancel = True
    ' on simule l'appuis sur la touche "Escape"
    SendKeys ("{ESC}")
    ' ce qui lance la gestion d'arrêt de lecture
End Sub

@ bientôt

LouReeD

Bonjour,

merci pour vos efforts mais ça ne fonctionne pas, c'est toujours la même erreur

Erreur 50290 :

La méthode 'EnableCancelKey' de l'objet'_Application' a échoué

laissez tomber je vais garder la touche "Echap"

bon dimanche

@bientôt

merci

Ce qui m'épate dans le message d'erreur c'est le "_" à Application...

Mais c'est peut-être la structure du message qui veut ça.

@ bientôt

LouReeD

oui c'est bizarre

mais c'est bien ça

il y a sûrement un moyen mais bof

juste par curiosité, l'avez-vous essayé sur mon fichier?

car si ça fonctionne chez vous, cela viendrait donc d'Excel2007

@bientôt

Ok,

avez vous essayé en mettant {ESCAPE} à la place de {ESC} ?

@ bientôt

LouReeD

Bonjour,

non, mais je viens de changer et c'est pareil

merci pour tout

mais est-ce que ça fonctionne avec mon fichier, chez vous?

@bientôt

Quel fichier ? Le dernier que j'ai essayé il m'a fallu comprendre qu'il fallait faire "esc" et une fois compris j'ai eu le msgbox... Mais je n'ai pas fait plus de test...

@ bientôt

LouReeD

Bonjour

Ceci fonctionne également : même code pour le double clique et simplification du code erreur :

On error goto fin

Application.Speech.Speak "le texte qui est un peu long"

Fin:

Désolé je n'y arrive pas bien sur le téléphone... Je dis ça pour la balise "code" non utilisée...

@ bientôt

LouReeD

Bonjour,

ci-joint mon fichier normalement fini mais si vous arrivez à positionner le doubleclic pour arrêter la lecture alors Bravo!

À Ce sujet :

Quel fichier ? Le dernier que j'ai essayé il m'a fallu comprendre qu'il fallait faire "esc" et une fois compris j'ai eu le msgbox... Mais je n'ai pas fait plus de test...

J'ai oublié de vous répondre.

Les indications sont en bas de la feuille active mais il est possible qu'elles soient cachées par l'écran

J'ai ajouté le zoom et mis à 65% à l'ouverture. Ci_joint mon nouveau fichier

Bonne soirée

@ bientôt et merci pour tout

Bonsoir,

essayez ceci :

J'ai ajouté sous "ThisWorkbook" un événementielle "double clic" avec une gestion de nom de feuille, si cela commence par TEXTE alors un SENDKEYS ESC est généré, ceci simule la touche ESC suite à un double clic sur ces feuilles.

@ bientôt

LouReeD

Bonjour et merci beaucoup,

On peut aussi dire vous, que vous ne lâchez rien.

Mais vous avez mis un fichier car je ne le vois pas. Peut être parce que je suis sur mon portable ?

@bientôt

Je suis fatigué !

Le fichier c'est dès que je peux !

@ bientôt

LouReeD

tranquillou

On est pas aux pièces,

Vous faites comme vous pouvez et quand vous avez du temps, car ce n'est vraiment pas Urgent, juste pour le fun

merci

@bientôt

Bonsoir,

le fichier :

@ bientôt

LouReeD

Bonjour,

merci mais ce n'est plus la peine de te tracasser car ça ne fonctionne toujours pas.

tous ces codes sont en rouge chez moi:

'Fonctions API du registre
Declare PtrSafe Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, _
ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, _
lpdwDisposition As Long) As Long
Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare PtrSafe Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare PtrSafe Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

merci de ton aide vraiment sympa

@ bientôt

Oups !

Etant en 64 bits j'ai du rajouter PtrSafe à chaque declaration ! Enlevez les et cela devrait aller chez vous.

@ bientôt

LouReeD

Bonjour,

merci

mais ça ne fonctionne toujours pas,

je double clic, j'ai bien le message (MsgBox) qui s'affiche mais pas d'arrêt. La lecture continue sans interruption.

@bientôt

Bonsoir,

en plus le code ne prenait pas en compte la différence d'écriture entre TEXTE et Texte !

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If UCase(Left(Sh.Name, 5)) = "TEXTE" Then
        Cancel = True
        SendKeys ("{ESC}")
    End If
End Sub

Essayez en supprimant tous les codes "MsgBox" qui se trouvent sur les feuilles en ne laissant que la mise en route de la lecture lors de l'activation.

@ bientôt

LouReeD