Discussion :

[Dadoo57]

Bonjour, j'ai le code ci-dessous mais depuis quelques jours la réutilisation d'un groupe est mal interprété dans le ReplaceWith. Par exemple si j'ai le texte suivant "…Hello" j'obtiens "…H ello" avec un espace après le H au lieu de le mettre avant.
Si je vais dans word puis fait Ctrl+H pour avoir la fenêtre rechercher/remplacer, que je coche les caractères générique et que je colle dans recherchee "^0133([A-Za-zÀ-ÖØ-öø-ÿ0-9])" et dans remplacer "… \1" j'ai la même erreur, un espace après le H au lieu de le mettre avant.

Est-ce qu'un paramètre de mon VBA a changé ou dans Word ces jours-ci ? J'ai réinstallé Word365 Family 3 fois, j'ai fais les mises à jours de Office365 Family. Il me semble que ce problème est apparu après la dernière mise à jour Windows 11 le 12 ou 13 février 2025. Est-ce quelqu'un rencontre ce problème ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Do 
    positionInitiale = texte.start
    texte.Find.ClearFormatting
    texte.Find.Replacement.ClearFormatting
    texte.Find.MatchWildcards = True
    texte.Find.Execute findText:="^0133([A-Za-zÀ-ÖØ-öø-ÿ0-9])", ReplaceWith:="… \1", Replace:=2
Loop While texte.start <> positionInitiale

Suivant mes tests, cette erreur apparait dans Word de Office 365 Familly mais pas dans Office 2016 pro plus et Office 365 Apps for Entreprise. Cette erreur est créée aussi bien dans Ctrl+H que dans du code VBA.

[E KERGRESSE]

Bonjour,

Regardez si dans Options / Vérification / Options de correction automatique, vous auriez cette correction automatique.

[Nain porte koi]

Hello,

je ne reproduis pas le problème avec Word 365 (2501) et Windows 11 23h2 (je n'arrive pas à installer la 24h2)

[Dadoo57]

Bonjour et merci pour votre retour !

j'ai supprimé les corrections en cours de frappe mais rien à faire la capture de groupe avec les caractères générique ne marche plus en vba.

[Dadoo57]

Hello,

je ne reproduis pas le problème avec Word 365 (2501) et Windows 11 23h2 (je n'arrive pas à installer la 24h2)

C'est étonnant, avez-vous pu essayer dans une macro vba ? J'ai la version 2501 (build 18429.20158 Office) et Windows 11 Famille 24h2

[Nain porte koi]

J'avais essayé en direct car je n'avais pas complété votre macro pour la tester.
Mais même en complétant ça me donne le bon résultat

[Dadoo57]

J'avais essayé en direct car je n'avais pas complété votre macro pour la tester.
Mais même en complétant ça me donne le bon résultat

En fait cela vient de ActiveDocument.TrackRevisions = True que j'ai en début de procédure. Dans ce cas la capture du groupe entre () ne peut pas être utilisé avec le \1 dans le remplacer, si non ça fait n'importe quoi.

Donc le code suivant fonctionne si ActiveDocument.TrackRevisions = True

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
texte.Find.ClearFormatting '  la variable texte est une Range
texte.Find.Replacement.ClearFormatting
texte.Find.MatchWildcards = True
texte.Find.Execute FindText:="…([A-Za-zÀ-ÖØ-öø-ÿ0-9])", ReplaceWith:="… \1", Replace:=wdReplaceAll

La solution que j'ai pour garder une vue sur les modifications apportées, c'est le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
With texte 
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True
    .Text = "…[A-Za-zÀ-ÖØ-öø-ÿ0-9]"
    .Wrap = wdFindStop
    .Forward = True
  End With
  Do While .Find.Execute
    .Characters.First.InsertAfter " "
    .Collapse wdCollapseEnd
  Loop
End With

Je n'ai malheureusement rien trouvé d'autre dans ce contexte

[Nain porte koi]

Ben c'est sûr que si vous ne donnez pas tous le code ça ne produira pas le même effet

[Dadoo57]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Sub M2_RTF_CorrectionPonctuation_WIP()    
	Dim objWord As Object
    Dim objDoc As Object
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim dossier As String
    Dim texte As Range
 
	With Application.fileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez le dossier contenant les fichiers RTF"
        .InitialFileName = ActiveDocument.Path & "\rtfs" '"." 'dossierParDefaut 
        If .Show = -1 Then
            dossier = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
 
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(dossier)
 
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False 
 
    For Each objFile In objFolder.Files
        If LCase(objFSO.GetExtensionName(objFile.Name)) = "rtf" Then
            nbrFilesToDo = nbrFilesToDo + 1
        End If
    Next
 
    If nbrFilesToDo < 1 Then
        objWord.Quit
        Set objWord = Nothing
        Set objFolder = Nothing
        Set objFSO = Nothing
 
        MsgBox "Pas de fichiers RTF à traiter dans le dossier sélectionné !", vbInformation        
        Exit Sub
    End If
 
    Set regex = CreateObject("VBScript.RegExp")
 
    For Each objFile In objFolder.Files
 
        If LCase(objFSO.GetExtensionName(objFile.Name)) = "rtf" Then
 
            Set objDoc = objWord.Documents.Open(objFile.Path, ReadOnly:=False)             
 
            objDoc.TrackRevisions = True ' <====== c'est ici le problème si à true les captures ne  peuvent pas être utilisées avec \1 dans le remplacer
 
            Set texte = objDoc.content
 
			With texte.Find
			  .ClearFormatting
			  .Replacement.ClearFormatting
			  .Execute FindText:="...", ReplaceWith:="…", MatchWildcards:=True, format:=False, Wrap:=wdFindContinue, Replace:=wdReplaceAll
			End With
 
			Application.ScreenUpdating = False
			With texte.Find
			  .ClearFormatting
			  .Replacement.ClearFormatting
			  .Execute FindText:="…([A-Za-zÀ-ÖØ-öø-ÿ0-9])", ReplaceWith:="… \1", MatchWildcards:=True, format:=False, Wrap:=wdFindContinue, Replace:=wdReplaceAll
			End With
			Application.ScreenUpdating = True			
 
            objDoc.Save
            objDoc.Close False
        End If
    Next objFile
 
    objWord.Quit
 
    Set objDoc = Nothing
    Set objWord = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing    
    Set regex = Nothing
End Sub

[Nain porte koi]

Ah ok... Quelques réflexions :
- Application.ScreenUpdating = False devrait être placé en début de module ou, du moins, en début de recherche pas au milieu de la procédure
- à quoi sert le " Set regex = CreateObject("VBScript.RegExp")" finalement ?
- Vous remplacez 3 points "..." par un point d'interrogation "?".
* Dans le code original c'était le caractère point de suspension "…"
* D'autres points d'interrogation peuvent se retrouver un peu partout dans le texte original
- Vous remplacez le "?" suivi de n'importe quel caractère par le "?" suivi d'une espace et du caractères trouvé, cela va donc remplacer tous les "?qqchose" par "? qqchose", ok, mais du coup vous ne maitrisez plus le remplacement simple des points de suspensions. Perso je vous conseillerais un caractère qui a peu de chance de se retrouver dans ce document comme "µ" ou "§" ou autre, et enfin c'est "..." ou "…" que vous voulez remplacez ?

Question : le mode suivi des modifications fonctionne aussi sur les RTF ?