Merci les mecs pour ces encouragements !
Yannick Daniel Youalé
La programmation est une religion. Aimez-la, ou quittez-la.
Mon site: www.visuweb.net
----- Original Message -----
From: paulber007
To: [email protected]
Sent: Friday, January 23, 2015 8:04 AM
Subject: [progliste] Re: Word- module pour trouver un texte de couleur
différente
Bonjour et très bonne année à tous,
Félicitation Yannick pour cette belle nouvelle.
Tu feras, sans discuter, un gros bisous de notre part à la maman qui t'as
fais un aussi beau cadeau!!!.
Nous espérons que tu auras toujours autant de temps pour nous concocter ces
petits bout de code, car ce petit être va en demander beaucoup au début.
Bonne journée.
Amitiés.
Paul.Le 22/01/2015 15:14, Yannick Youalé a écrit :
Salut à tous !
J'avais posé le problème sur cette liste il y a quelques jours.
Et il m'avait été indiqué l'outil des suivis de modifications pour traquer
les changements à un document word.
Quoi que la fonctionnalité de recherche du texte de couleur différente m'a
semblé malgré tout avoir une certaine utilité, même si ce n'était pas seulement
pour repérer d'éventuelles modifications qu'un précédent rédacteur aurait placé
dans le document word.
Et c'est ainsi qu'ayant un peu de temps libre... parce que bénéficiant en
ce moment d'un congé de paternité, je me suis mis au développement d'un module
permettant de le faire.
Je vous colle le code du module plus bas.
Il est constitué au total de quatre fonctions & procédures.
Les deux première (TotoNextDifferentColor et GotoPriorDifferentColor) sont
les procédures principales, qui ont pour rôle de déplacer le curseur à la
prochaine ou à la précédente portion de texte de couleur différente, et elles
utilisent la synthèse vocale active pour faire lire le texte de la portion en
question.
Un peu comme une recherche précédente et suivante, mais uniquement pour la
couleur du texte.
Ce sont ces deux procédures qui doivent être déclenchées par des menus ou
des raccourcis clavier selon votre préférence.
Voici le code du module:
Début du code VBA
' module 1
Option Explicit
Public Sub GotoNextDifferentColor()
' amène le curseur à la prochaine couleur différente
Dim d As Document
Dim s As String
Dim c As Range
Dim l As Long
Dim l2 As Long
Dim lPos As Long
Dim lCount As Long
Dim lColor As Long
Dim lLastColor As Long
Dim flag As Boolean
' référence au document courant
Set d = ActiveDocument
' on identifit la position courante du curseur dans le texte
lPos = Selection.Range.Characters(1).Start
' on identifit la couleur du texte à cet emplacement
lLastColor = d.Characters(lPos + 1).Font.Color
' on trouve le nombre de caractères total dans le document
lCount = d.Characters.Count
' parcours caractère après caractère
' de la position courante+1 jusqu'à la fin
On Error Resume Next
For l = (lPos + 1) To lCount
Set c = d.Characters(l)
' on recueille la valeur de la couleur du caractère actuelle
lColor = c.Font.Color
' on la compare avec la dernière enregistrée
If lColor <> lLastColor Then
' on recueille tout le texte mis à cette couleur
s = vbNullString
For l2 = l To lCount
If lColor = d.Characters(l2).Font.Color Then
s = s & d.Characters(l2).Text
Else
Exit For
End If
Next ' caractère suivant en vue de retrouver le texte en couleur
' positionnement du curseur à l'endroit où la couleur différente commence
GotoPosition l
' lecture par la synthèse vocale
SayText s
' on marque qu'une occurence a été trouvée
flag = True
' on sort de la boucle principale
Exit For
End If ' fin si changement de couleur
Next ' caractère suivant
' cas où aucune occurence n'a été trouvée
If flag = False Then
' lecture d'un message par la synthèse vocale
SayText "Aucune couleur différente suivante trouvée"
End If
' libération
Set d = Nothing
End Sub
Public Sub GotoPriorDifferentColor()
' amène le curseur à la précédente couleur différente
Dim d As Document
Dim s As String
Dim c As Range
Dim l As Long
Dim l2 As Long
Dim lPos As Long
Dim lCount As Long
Dim lColor As Long
Dim lLastColor As Long
Dim flag As Boolean
' référence au document courant
Set d = ActiveDocument
' on identifit la position courante du curseur dans le texte
lPos = Selection.Range.Characters(1).Start
' on identifit la couleur du texte à cet emplacement
lLastColor = d.Characters(lPos + 1).Font.Color
' on trouve le nombre de caractères total dans le document
lCount = d.Characters.Count
' parcours caractère après caractère
' de la position courante+1 jusqu'au début
On Error Resume Next
For l = (lPos - 1) To 0 Step -1
Set c = d.Characters(l)
' on recueille la valeur de la couleur du caractère actuelle
lColor = c.Font.Color
' on la compare avec la dernière enregistrée
If lColor <> lLastColor Then
' on recueille tout le texte mis à cette couleur
s = vbNullString
For l2 = l To 0 Step -1
If lColor = d.Characters(l2).Font.Color Then
s = d.Characters(l2).Text & s
Else
Exit For
End If
Next ' caractère suivant en vue de retrouver le texte en couleur
' positionnement du curseur à l'endroit où la couleur différente commence
GotoPosition l2
' lecture par la synthèse vocale
SayText s
' on marque qu'une occurence a été trouvée
flag = True
' on sort de la boucle principale
Exit For
End If ' fin si changement de couleur
Next ' caractère suivant
' cas où aucune occurence n'a été trouvée
If flag = False Then
' lecture d'un message par la synthèse vocale
SayText "Aucune couleur différente précédente trouvée"
End If
' libération
Set d = Nothing
End Sub
Public Function SayText(ByVal s As String, Optional ByVal blInterrupt As
Boolean = False) As Boolean
'
Dim o As Object
On Error Resume Next
' création d'un objet JFW
Set o = CreateObject("freedomsci.jawsapi")
If o Is Nothing Then
SayText = False
Exit Function
End If
' lecture du texte
o.SayString (s)
End Function
Public Function GotoPosition(ByVal lNewPos As Long, Optional ByVal lLastPos
As Long = -1) As Boolean
' déplace le curseur à une position donnée dans le texte
Dim l As Long
Dim d As Document
'
Set d = ActiveDocument
' la position courante
If lLastPos = -1 Then
lLastPos = Selection.Start
End If
' on trouve la différence ou valeur du déplacement
l = lNewPos - lLastPos
' selon la polarité, on va à gauche ou à droite
If l > 0 Then
' on va à droite
Selection.MoveRight _
Unit:=Word.WdUnits.wdCharacter, Count:=l, _
Extend:=Word.WdMovementType.wdMove
Else
' on va à gauche
Selection.MoveLeft _
Unit:=Word.WdUnits.wdCharacter, Count:=Abs(l), _
Extend:=Word.WdMovementType.wdMove
End If
' on vérifit si le déplacement s'est effectivement effectué
GotoPosition = (lLastPos <> Selection.Start)
' libération
Set d = Nothing
End Function
Fin du code VBA
Et pour ceux qui en sont resté à ce que j'ai annoncé plus haut, oui je suis
un nouveau papa, d'une toute petite et mignone petite fille.
Amicalement !
Yannick Daniel Youalé
La programmation est une religion. Aimez-la, ou quittez-la.
Mon site: www.visuweb.net
