[Toutes versions] [VBA] Macro permettant de compter les caractères de chaque ligne d'un tableau

[SiLiCe]

Bonjour à tous !

Dans le cadre de la création de test de sous-titrage, je dois créer une macro-commande dans Word permettant de "limiter" le nombre de caractères entrés par ligne dans un tableau.

Ce tableau serait consititué de deux colonnes : une source, contenant le texte à traduire, et une cible, dans laquelle le traducteur devra rentrer le texte.
Chaque cellule de la deuxième colonne de ce tableau pourra cotenir 2 lignes au maximum.

Le but serait de faire en sorte que si le traducteur entre plus de 35 caractères par ligne (et non par cellule), le texte devienne rouge (couleur ou surligné) pour lui signifier qu'il a trop écrit.

Je suis consciente que cela ne dois pas être bien sorcier, malheureusement mes cours de Macro-commandes sont déjà un peu loin et je me retrouve coincée.

Voici ce que j'ai fait pour l'instant... et qui ne fonctionne pas :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub RedLines()
 
Dim Ligne As Object
Dim Caract As String
Dim TotalCaract As Integer
Dim i As Integer
 
TotalCaract = Len(Caract)
For i = 1 To TotalCaract
 
For Each Ligne In ActiveDocument.Table
 
If TotalCaract > 35 Then
Ligne.HighlightColorIndex = wdRed
End If
 
Next Ligne
Next i
 
End Sub

Pouvez-vous m'aider ?
Merci,

[Heureux-oli]

Envoyé par SiLiCe

Bonjour à tous !


Je suis consciente que cela ne dois pas être bien sorcier, malheureusement mes cours de Macro-commandes sont déjà un peu loin et je me retrouve coincée.

Salut,

Ça l'est !
Word ne prend pas en compte la frappe comme étant un évènement.
On peut après la frappe faire un compte du nombre de caractères, mais pas au cours de la frappe.

[carden752]

Bonjour,

Une solution qui marche cependant cela ralentit forcément le traitement.
En effet, cela consiste en une boucle infinie avec vérification régulière et rajouter le surlignage ou enlever celui-ci

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Public WithEvents app As Application 'Gestion des évènements
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'utilie pour utiliser la fonction sleep (Attente)
 
Sub RedLines()
 
Dim Caract As Range
Dim TotalCaract As Integer
Dim ligne As Row
 
For Each ligne In ActiveDocument.Tables(1).Rows 'traiter les lignes du tableau 1 
Set Caract = ligne.Range
TotalCaract = Caract.Characters.Count
TotalCaract = TotalCaract - (ligne.Cells.Count + 1) 'Enlever les caractères de fin de cellule et de fin de ligne
If TotalCaract > 35 Then
ligne.Range.HighlightColorIndex = wdRed 'surlignage
Else
ligne.Range.HighlightColorIndex = white 'enlever le surlignage
End If
Next ligne
End Sub
 
 
Private Sub Document_Close() 'Fermeture du document
Set app = Nothing
End Sub
 
Private Sub Document_Open() 'Ouverture du document
Set app = Application 'Initialiser l'instance
While (1) 'Boucle
Call RedLines 'Appeler fonction de surlignage
    Sleep (10)   'Attendre 10ms (Vérification toutes les 10 milisecondes)
    DoEvents 'Rendre la main au système
 Wend
End Sub

J'espère que cela peut te convenir