Discussion :

[zaz38000]

Bonjour à tous,

Je suis une petite pussy du dimanche en Pascal un très vieuxxx language!
Mais la pour le coup j'aimerais faire un peu de pré-traitement via macro VBA Word, mais ça n'a pas l'air si simple!

Mon besoin : Dans un document Word (du coup) contenant normalement pas mal de signet, j'aimerais :

• Sélectionner un signet --> Réalisé!
• Définir une plage entre ce signet et le prochain saut de page --> Plus complexe, mais réalisé (peut-être pas très propre)
• Sur cette plage faire deux pré-traitement :
  
• J'aimerais pouvoir différentier les éléments séparés par " ; "
• J'aimerais aussi pouvoir faire pareil avec les élément séparés par un " / "
• Faire enfin du pré traitement avec ces infos!

[Invité]

J'ai mis en pièce jointe mon fichier de départ(doc2) avec ma macro de départ (MacroPostTraitementLangue) qui n'est qu'un brouillon de newby.

Bonjour,

Votre macro n'est pas dans Doc2. Elle doit être restée dans Normal.dotm.

Le mieux est de mettre votre macro en ligne entre balises #.

[zaz38000]

Bonjour,

Oui veuillez m'excuser de ne pas avoir vérifié, voici le bout de code que j'ai commencé à faire :

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 MacroPostTraitementLangue()
'
' MacroPostTraitementLangue
' Ne pas modifier nom du signet ni rajouter de signet
 
Dim SautTrouvé As Boolean
Dim Fin As Range
Dim MaSélection As Range
Dim ZoneRecherche As Range
'Dim TableaudeSignet(3) As String
'TableaudeSignet(0) = "General_informations"
'TableaudeSignet(1) = "b"
'TableaudeSignet(2) = "c"
 
Dim Signet As String
 
Signet = "General_informations"
 
    For I = 1 To ActiveDocument.Bookmarks.Count
        With ActiveDocument
            ' zone de recherche du signet à la fin du document
            Set ZoneRecherche = _
            .Range(Start:=.Bookmarks(Signet).Range.Start, _
            End:=.Bookmarks("EndOfDoc").Range.End)
            ' recherche du saut de page manuel qui suit
            ZoneRecherche.Find.ClearFormatting
            With ZoneRecherche.Find
                .Text = "^p"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindStop ' avant wdFindStop
            End With
            SautTrouvé = ZoneRecherche.Find.Execute
            If SautTrouvé Then
                Set Fin = ZoneRecherche
            Else
                ' pas trouvé : fin = fin du document
                Set Fin = .Bookmarks("EndOfDoc").Range
            End If
            ' +1 pour inclure le saut de page dans la sélection
            Set MaSélection = _
            .Range(.Bookmarks(Signet).Range.Start, _
            Fin.End + 1)
            MaSélection.Select
        End With
    Next
        'For j = 1 To TableaudeSignet.Count
            'If ActiveDocument.Bookmarks.Item(I) = TableaudeSignet(j) Then
                'ActiveDocument.Range.GoTo What:=wdGoToField, Name:=vbCrLf
                'ActiveDocument.Range(ActiveDocument.Bookmarks.Item(I).Range.Start, ActiveDocument.Bookmarks.(sName).Range.End).Select
            'End If
        'Next    
End Sub

J'ai mis en commentaire les parties qui ne fonctionne pas, j'arrive avec ce bout de code à atteindre le range souhaité, mais je n'ai pas trop d'idée pour le parser comme demandé.

Bonne journée

[Invité]

Je ne sais pas si on parle de la même chose, mais voilà un code correspondant à ce que vous demandez dans votre message initial :

Pour extraire les parties 1, 2, ou 3 de votre chaine, modifier la valeur de la variable PositionChaine dans la procédure TestExtraction

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
 
Option Explicit
 
Public MatriceResultat() As Variant
 
Sub Extraction(ByVal DocEnCours As Document, ByVal RangSelectionne As Integer)
 
Dim ParagrapheEnCours As Paragraph
Dim I As Integer, J As Integer, K As Integer, NbEntreSlashs As Integer, NbParagraphes As Integer
Dim EntrePointVirgules As Variant, EntreSlashs As Variant
Dim MatriceTextes() As Variant
 
 
    With DocEnCours
         NbEntreSlashs = 0
         NbParagraphes = 0
         For I = 1 To .Paragraphs.Count
             If InStr(1, .Paragraphs(I).Range.Text, ";", vbTextCompare) > 0 And InStr(1, .Paragraphs(I).Range.Text, "/", vbTextCompare) > 0 Then
                EntrePointVirgules = Split(.Paragraphs(I).Range.Text, ";")
                For J = LBound(EntrePointVirgules) To UBound(EntrePointVirgules)
                    EntreSlashs = Split(EntrePointVirgules(J), "/")
                    If NbEntreSlashs < UBound(EntreSlashs) Then NbEntreSlashs = UBound(EntreSlashs)
               Next J
 
               ReDim MatriceTextes(UBound(EntrePointVirgules), NbEntreSlashs)
 
               EntrePointVirgules = Split(.Paragraphs(I).Range.Text, ";")
               For J = LBound(EntrePointVirgules) To UBound(EntrePointVirgules)
                   EntreSlashs = Split(EntrePointVirgules(J), "/")
                   For K = LBound(EntreSlashs) To UBound(EntreSlashs)
                       MatriceTextes(J, K) = EntreSlashs(K)
                   Next K
              Next J
 
              ReDim Preserve MatriceResultat(NbParagraphes)
              For J = LBound(MatriceTextes, 1) To UBound(MatriceTextes, 1)
                  MatriceResultat(NbParagraphes) = MatriceResultat(NbParagraphes) & MatriceTextes(J, RangSelectionne - 1) & ";"
              Next J
              MatriceResultat(NbParagraphes) = Mid(MatriceResultat(NbParagraphes), 1, Len(MatriceResultat(NbParagraphes)) - 1)
              NbParagraphes = NbParagraphes + 1
 
            End If
 
         Next I
 
 
    End With
 
End Sub
 
Sub TestExtraction()
 
Dim DocATraiter As Document
Dim X As Integer, PositionChaine As Integer
 
 
    PositionChaine = 1  ' Dans l'exemple du message choisir 1 ou 2 ou 3
 
    Erase MatriceResultat
    Extraction ActiveDocument, PositionChaine
    For X = LBound(MatriceResultat, 1) To UBound(MatriceResultat, 1)
        MsgBox MatriceResultat(X)
    Next X
 
End Sub

[zaz38000]

Salut,

Merci pour la réponse ça m'a bien aidé dans le travail à réaliser!
J'ai adapté le code pour fonctionner parfaitement au besoin.

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
Public MatriceResultat() As Variant
Sub LaunchChoiceLanguageSentence()
 
Dim DocATraiter As Document
Dim X As Integer, PositionChaine As Integer
 
    ' Choisir la position de la phrase à sélectionner
    PositionChaine = 2
 
    Erase MatriceResultat
    ChoiceLanguageSentence ActiveDocument, PositionChaine
 
End Sub
 
Sub ChoiceLanguageSentence(ByVal DocEnCours As Document, ByVal RangSelectionne As Integer)
 
Dim ParagrapheEnCours As Paragraph
Dim I As Integer, J As Integer, K As Integer, iNbEntreSlashs As Integer, iNbParagraphes As Integer, iMatrice As Integer
Dim EntrePointVirgules As Variant, EntreSlashs As Variant
Dim MatriceTextes() As Variant
Dim bSautTrouvé As Boolean
Dim Fin As Range
Dim MaSélection As Range
Dim ZoneRecherche As Range
Dim sSignet As String, sSelection As String
Dim MonDico As Collection
Set MonDico = New Collection
 
    'Initialization
    iMatrice = 0
    'Rajouter les signets dans des dicos : ajout de la paire Clé + Valeur dans le Dictionnaire
    MonDico.Add "1", "sec1_2_Relevant_identified_uses"
    MonDico.Add "2", "sec1_2_Uses_advised_against" 
 
    iNbEntreSlashs = 0
    iNbParagraphes = 0
    For I = 1 To DocEnCours.Bookmarks.Count
        sSignet = DocEnCours.Bookmarks.Item(I).Name
        If CleEstPresente(MonDico, sSignet) = True Then 'Vérifier si le signet dans le dico
            With DocEnCours
                ' zone de recherche du signet à la fin du document
                Set ZoneRecherche = _
                .Range(Start:=.Bookmarks(sSignet).Range.Start, _
                End:=.Bookmarks("EndOfDoc").Range.End)
                ' recherche du saut de page manuel qui suit
                ZoneRecherche.Find.ClearFormatting
                With ZoneRecherche.Find
                    .Text = "^p"
                    .Replacement.Text = ""
                    .Forward = True
                    .Wrap = wdFindStop
                End With
                bSautTrouvé = ZoneRecherche.Find.Execute
                If bSautTrouvé Then
                    Set Fin = ZoneRecherche
                Else
                    ' pas trouvé : fin = fin du document
                    Set Fin = .Bookmarks("EndOfDoc").Range
                End If
                ' +1 pour inclure le saut de page dans la sélection
                Set MaSélection = _
                .Range(.Bookmarks(sSignet).Range.Start, _
                Fin.End + 1)
                MaSélection.Select
            End With
            ' Next with the range select only what you need
            sSelection = MaSélection.Text
            If InStr(1, sSelection, ";", vbTextCompare) > 0 And InStr(1, sSelection, " / ", vbTextCompare) > 0 Then
                EntrePointVirgules = Split(sSelection, ";")
                For J = LBound(EntrePointVirgules) To UBound(EntrePointVirgules)
                    EntreSlashs = Split(EntrePointVirgules(J), " / ")
                    If iNbEntreSlashs < UBound(EntreSlashs) Then iNbEntreSlashs = UBound(EntreSlashs)
                Next J
 
                ReDim MatriceTextes(UBound(EntrePointVirgules), iNbEntreSlashs)
 
                EntrePointVirgules = Split(sSelection, ";")
                For J = LBound(EntrePointVirgules) To UBound(EntrePointVirgules)
                    EntreSlashs = Split(EntrePointVirgules(J), " / ")
                    For K = LBound(EntreSlashs) To UBound(EntreSlashs)
                        MatriceTextes(J, K) = EntreSlashs(K)
                    Next K
                Next J
 
                ReDim Preserve MatriceResultat(iNbParagraphes)
                For J = LBound(MatriceTextes, 1) To UBound(MatriceTextes, 1)
                    MatriceResultat(iNbParagraphes) = MatriceResultat(iNbParagraphes) & MatriceTextes(J, RangSelectionne - 1) & ";"
                Next J
                MatriceResultat(iNbParagraphes) = Mid(MatriceResultat(iNbParagraphes), 1, Len(MatriceResultat(iNbParagraphes)) - 1)
                iNbParagraphes = iNbParagraphes + 1
            End If
            ' On a le texte à remplacer et la sélection dans un range suffit de faire le replace
            MaSélection.Text = CStr(MatriceResultat(iMatrice)) + vbCrLf + vbCrLf
            iMatrice = iMatrice + 1
        End If
    Next
    'pour supprimer le Dictionnaire de la mémoire
    Set MonDico = Nothing
End Sub
' Permet de savoir si une cle est présente dans le dico sans retourner d'erreur
Public Function CleEstPresente(Dico As Collection, Cle As Variant) As Boolean
    Dim TestObject As Variant
    On Error GoTo CleEstPresenteErreur
        CleEstPresente = True
        TestObject = Dico(Cle)
        Exit Function
CleEstPresenteErreur:
        CleEstPresente = False
End Function

J'ai mis du temps à réaliser comment faire pour remplacer la sélection "MaSélection.Text=" j'étais fatigué!

Bon j'ai encore des petits bugs sur les signets, mais je suis bien avancé je vais regarder ça, merci pour la réponse

Bonne journée