Discussion :

[nicoladastra2]

Bonjour,

Alors, voilà mon besoin :

J'ai un fichier word avec des tags à l'intérieur, de types <g1> blabla </g1> <g2> blablabla </g2>. Le problème, c'est que parfois je reçois des fichiers où ces tags s'entremêlent ("nested formatting") de cette façon :
<g1> <g2> blablabla </g2> blablabla </g1>

Cela pose un gros problème dans mon système qui n'arrive pas à lire le fichier. Il me faut donc rétablire l'ordre d'apparition des tags. Je voudrais que cela se fasse automatiquement, parce que dans de très gros fichiers (où les tags vont jusqu'à <g600>...) je pourrais y passer des heures... et devenir fou !

Donc, mon idée est d'isoler ces tags dans un fichier texte ou Excel (ce que j'ai déjà réussi à faire avec le code ci-dessous, à l'aide de regex, ça fonctionne bien). Le problème est qu'ensuite, je ne sais trop comment faire pour :
- 1 repérer automatiquement les tags emmêlés
- 2 les remettre dans le bon ordre
- 3 reprendre la liste ainsi corrigée et procéder automatiquement aux changements dans le fichier d'origine

J'imagine qu'il me faudrait créer un tableau externe, sans doute dans excel, et utiliser une fonction spécifique de tri. Par contre pour le réimport, je sèche complètement... J'espère que quelqu'un ici pourrait m'aider ! Merci d'avance !

//// Voici une liste ainsi générée par mon code VBA ///

<g3>
</g3>
<g4>
</g4>
<g5>
</g5>
<g6>
</g6>
<g8>
</g8>
<g10>
</g10>
<g12>
</g12>
<g14>
</g14>
<g16>
</g16>
<g17>
</g17>
<g22>
<g23> >>>> ici on peut déjà repérer un problème, comme décrit plus haut
</g23>
</g22>

/// Voici le code VBA que j'ai produit jusqu'à présent et qui fonctionne pour générer la dite liste ///

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
 
Sub AAAExtract_WildCard_Matches()
 
Dim sWildCard As String
Dim sDir
Dim oWD As Word.Document
Dim sPath As String
 
 
sWildCard = "\<[g/]{1;2}[0-9]{1;4}\>"
 
sPath = "C:\Users\XXXX\Desktop\"
sDir = Dir$(sPath & "*.doc", vbNormal)
 
Do Until LenB(sDir) = 0
 
 Set oWD = Documents.Open(sPath & sDir)
 
    Open "C:\Mein-Ordner\Match_Output.txt" For Append As #1
 
        Selection.Find.Font.Hidden = False
        Selection.HomeKey wdStory, wdMove
 
        Selection.Find.Execute FindText:=sWildCard, MatchWildcards:=True
 
        Do While Selection.Find.Found
 
            Print #1, Selection.Range.Text
 
            Selection.Range.Collapse wdCollapseEnd
 
            Selection.Find.Execute
        Loop
 
    Close #1
 
 oWD.Close False
 
 sDir = Dir$
 
Loop
 
 
End Sub

[carden752]

Bonjour,

Est-ce qu'il y a du texte en dehors des tags?
si tu as <g1>blabla1<g2>blabla2</g2>blabla1B<g3>blabla3</g3></g1>.
Est-ce que tu dois retrouver cette valeur?
<g1>blabla1blabla1B</g1><g2>blabla2</g2><g3>blabla3</g3>

Si c'est la cas je partirai sur une première boucle pour identifier la plus haute valeur
Puis je traiterai dans une boucle à l'envers en mettant toujours en début de document toute la partie concernée entre les 2 balises après le premier passage
<g3>blabla3</g3><g1>blabla1<g2>blabla2</g2>blabla1B</g1>
au deuxième passage
<g2>blabla2</g2><g3>blabla3</g3><g1>blabla1blabla1B</g1>

au dernier passage, on aurait bien
<g1>blabla1blabla1B</g1><g2>blabla2</g2><g3>blabla3</g3>

Est-ce que cette solution te parait envisageable?
Je ne sais pas par contre ce que cela peut représenter en temps de calcul ces itérations multiples de déplacement de texte sans le tester.

[nicoladastra2]

Merci pour votre message !

Alors, j'ai un peu avancé depuis hier )

Mon code dans Word fonctionne pour exporter les tags vers un fichier externe, comme je l'expliquais auparavant. Maintenant, une fois la liste de tags exportée vers Excel, ensuite j'utilise ce code dans Excel :

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
 
Sub myTest()
 
   Dim myCel As Range
   Dim i As Integer
    i = 0
'copier le contenu de la colonne A dans la colonne B
 
   Columns("A:A").Select
    Selection.Copy
    Columns("B:B").Select
    ActiveSheet.Paste
 
'on supprime tout ce qui n'est pas un nombre
 
   With CreateObject("VBScript.Regexp")
         .Global = True
         .Pattern = "\D+"
  For Each myCel In Range("B1:B900")
           myCel.Value = .Replace(myCel.Value, "")
  Next
  End With
 
'Ranger les nombres par ordre croissant
 
    Columns("B:B").Select
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("B2:B25")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'Rajoute les tags après le tri dans l'ordre croissant
 
For Each myCel In Range("B1:B900")
    i = i + 1
    If myCel.Value <> "" Then
        If i Mod 2 Then
            myCel.Value = "<g" & myCel.Value & ">"
        Else
            myCel.Value = "</g" & myCel.Value & ">"
        End If
    Else
    End If
Next
 
End Sub

Ce code me permet de faire le tri, en fait je copie la première colonne dans la seconde, j'enlève tout ce qui n'est pas un chiffre, je range par ordre croissant puis je rajoute les balises autour des tags en alternant balises ouvertes et fermées. Tout fonctionne comme sur des roulettes). Par exemple, avec la liste que j'avais copiée ci-dessus, le résultat est le suivant :

<g3> <g3>
</g3> </g3>
<g4> <g4>
</g4> </g4>
<g5> <g5>
</g5> </g5>
<g6> <g6>
</g6> </g6>
<g8> <g8>
</g8> </g8>
<g10> <g10>
</g10> </g10>
<g12> <g12>
</g12> </g12>
<g14> <g14>
</g14> </g14>
<g16> <g16>
</g16> </g16>
<g17> <g17>
</g17> </g17>
<g22> <g22>
<g23> </g22>
</g23> <g23>
</g22> </g23>



Donc mon plan est le suivant :

1 - J'utilise dans Word ma macro n°1 (voir premier post)
2 - J'utilise dans Excel ma macro n°2 (dans ce post)
3 - Je modifie la macro n°1 de façon à ce que lors de la recherche, on remplace chacune des valeurs trouvées par les valeurs de mon tableau Excel. C'est là que le bât blesse car je ne sais pas comment faire !

MAINTENANT, ce qui me manque :

Comment introduire dans la première partie de mon code (celui de Word) que je modifierai (comme je l'expliquais avant) la fonction de remplacement dans le loop en allant chercher la nouvelle valeur dans Excel !

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
Do While Selection.Find.Found
 
ICI > Rajouter une fonction qui me permette d'aller piocher dans le fichier Excel en remplaçant chacune des valeurs trouvées par la valeur corrigée correspondante 
 
            'Print #1, Selection.Range.Text > plus besoin de cette ligne !
 
            'Selection.Range.Collapse wdCollapseEnd > plus besoin de cette ligne non plus !
 
            Selection.Find.Execute
Loop

[carden752]

Bonjour,

En fait tu veux juste remplacer les balises de la colonne1 par celle de la colonne2
Il suffit de parcourir l'ensemble des cellules et les mettre dans 2 variables, quelque chose de ce style

Code :

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

1
2
3
4
5
6
7
8
9
10
 
for i=1 to nombreremplacement
mavarrechercher=monexcel.range("A" & i)
mavarremplacer=monexcel.range("B" & i)
with selection.find
.text=mavarrechercher
.replacement.text=mavarremplacer
.execute wdreplaceall
end with
next i

[nicoladastra2]

Rebonjour et encore merci pour ton aide

Ça m'a l'air pas mal du tout ta piste, je vais creuser l'idée, faire des tests puis je reviendrai poster le résultat !

Par contre .execute wdreplaceall ne me semble pas correct, en effet il faudra qu'il remplace chaque trouvaille l'une après l'autre (avec l'itération) et pas faire un replaceall directement. Je crois qu'il me faudra un ".Find.Execute Replace:=wdReplaceOne" non ?

Sinon je cherche encore un code propre pour ouvrir Excel et aller y chercher la variable avant de mettre "mavarrechercher=monexcel.range("A" & i)"

[nicoladastra2]

Alors, le problème, c'est que dès que j'essaie modifier quelque chose dans le loop, il n'exécute qu'un seul remplacement... si je mets wdReplaceOne il ne remplace qu'un seul objet, si je mets wdReplaceAll il remplace tout par la même chose (j'ai aussi essayé avec une variable qui s'incrémente, il remplace tout par 1...)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 
Do While Selection.Find.Found
 
           Selection.Find.Replacement.Text = "BLOUUU"
           Selection.Find.Execute Replace:=wdReplaceOne
 
           Selection.Range.Collapse wdCollapseEnd
 
 
        Loop

[nicoladastra2]

Alors, j'ai entièrement modifié le code de la partie 1 pour que ça marche dans la partie 3, je suis très proche de la vérité là ! Le dernier problème, c'est que bien que j'arrive à lire les entrées du fichier Excel, il me fait des remplacements avec rien à la place du contenu de mes cellules !! Pourtant, quand je teste si le contenu des cellules du fichier Excel est bien lu, ça marche ! Mais dès que je veux faire un remplacement avec, ça ne remplace qu'avec du vent (en fait ça supprime les entrées trouvées...)

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
 
Sub AAA2First()
    Dim i As Long
    Dim myCell As String
    i = 1
    Set appExcel = CreateObject("Excel.Application")
    appExcel.Workbooks.Open ("C:\Mein-Ordner\PROG\VBA\ADAPT--24CAT-TAGS\testwithmacro.xls")
    appExcel.Visible = True
    myCell = appExcel.Worksheets("Tabelle1").Cells(1, 2).Value
 
    With ActiveDocument.Content.Find
        .Font.Hidden = False
        .MatchWildcards = True
        .Text = "\<[g/]{1;2}[0-9]{1;4}\>"
        .Replacement.Text = myCell
        .Wrap = wdFindContinue
 
        Do While .Execute(Replace:=wdReplaceOne) = True
            i = i + 1
            myCell = appExcel.Worksheets("Tabelle1").Cells(i, 2).Value
            .Replacement.Text = myCell
            Selection.TypeText Text:=myCell
        Loop
    End With
    Selection.TypeText Text:=myCell
    'appExcel.Workbooks.Close
 
 
End Sub

Aaaaah j'ai compris pourquoi : vu que je remplace des tags par d'autres tags, ils sont matchés à leur tour par ma fonction et au final ma liste est "mangée" et la liste ne trouve plus que des cellules vides ! Bon, il faut que je trouve le moyen d'avancer d'un cran à chaque fois dans la recherche...

[nicoladastra2]

Ok, j'ai résolu mon problème (en fait ce fil m'a surtout servi a bien comprendre ce que j'avais en tête moi-même), merci de fermer le sujet !