Découpage d'un document word

**Orda80** · 10/12/2019, 22h32

Bonjour à tous,

J'ai découvert qu'on peut utiliser VBA sur word, et j'ai besoin de votre aide pour trouver une solution de mon problème, en effet j'ai un document d'une centaine de page et j'ai besoin de :
- Découper le document en plusieurs parties selon un délimiteur ( à la fin de chaque partie je rajoute une marque par exemple "\\\")
- Garder le style de document (titres, paragraphes ... )
- Enregistrer chaque document découpé dans un nouveau document.

J'ai trouvé sur internet une solution qui permet de découper le document, sauf qu'elle ne permet pas de garder le style.
serait-il possible de m'aider s'il vous plait pour découper le document sans perdre le style.

Je vous remercie par avance pour votre aide

Cordialement,

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
Sub SplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim i As Long
    Dim X As Long
    Dim Response As Integer
 
 
 
        arrNotes = Split(ActiveDocument.Range, delim)
        Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
            If Response = 7 Then Exit Sub
            For i = LBound(arrNotes) To UBound(arrNotes)
                If Trim(arrNotes(i)) <> "" Then
                    X = X + 1
                    Set doc = Documents.Add
                    doc.Range = arrNotes(i)
                    doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
                    doc.Close True
                End If
            Next i
End Sub
Sub test()
'delimiter & filename
    SplitNotes "///", "Notes "
End Sub

Invité · 11/12/2019, 03h37

Envoyé par Orda80

Bonjour,

Pour avoir traité ce thème en avril 2018 sur le forum VBA Word (désolé je ne retrouve pas le message, mais une de mes réponses doit dater du 13/04/2018), vous devriez regarder la méthode consistant à dupliquer votre fichier en X fichiers puis à éliminer les X-1 parties dans chacun des fichiers (en commençant par la fin des documents).
Nb : Dans un premier temps la méthode utilisée était comparable à la vôtre, mais les fichiers résultants comptaient pratiquement 2 fois plus de pages que la partie concernée dans le document d'origine établi à partir d'un publipostage.

**Orda80** · 11/12/2019, 10h41

Bonjour Eric,

je vous remercie pour votre réponse, mon code marche bien au niveau de découpage, mon seul problème ce qu'il ne garde pas la mise en forme de fichier original. connaissez vous s'il vous plait une fonctionnalité qui permet de garder le style ?

Je vous remercie par avance.

Orda

Invité · 11/12/2019, 10h50

Envoyé par Orda80

Vous pourriez créer un modèle (template) .dotx ou dotm basé sur votre document source et au lieu de créer un document avec cette formule

Code :

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

Set doc = Documents.Add

Vous pourriez utiliser celle-ci :

Code :

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

1
2
3
    Documents.Add Template:= _
        "C:\Users\XXXXX\AppData\Roaming\Microsoft\Templates\MonModèle.dotm" _
        , NewTemplate:=False, DocumentType:=0

**Orda80** · 11/12/2019, 11h53

Bonjour Eric,

merci pour votre réponse rapide, j'ai testé votre ligne de code mais je n'ai toujours pas le bon style, je ne sais si le problème vient de la fonction Split ou je n'ai pas mis la fonction dans le bon endroit.

merci

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
Sub SplitNotes(delim As String, strFilename As String)
    Dim doc As Document
    Dim arrNotes
    Dim i As Long
    Dim X As Long
    Dim Response As Integer
 
 
 
        arrNotes = Split(ActiveDocument.Range, delim)
        Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections.Do you wish to proceed?", 4)
 
 
 
            If Response = 7 Then Exit Sub
 
        Documents.Add Template:= _
        "C:\Users\OurdaCOTTIN\Documents\Modèles Office personnalisés\test_modele.dotm" _
        , NewTemplate:=False, DocumentType:=0
 
            For i = LBound(arrNotes) To UBound(arrNotes)
                If Trim(arrNotes(i)) <> "" Then
                    X = X + 1
                    Set doc = Documents.Add
                    doc.Range = arrNotes(i)
                    doc.SaveAs ThisDocument.Path & "\" & strFilename & Format(X, "000")
                    doc.Close True
                End If
            Next i
End Sub
Sub test()
'delimiter & filename
    SplitNotes "///", "Notes "
End Sub

Invité · 11/12/2019, 11h57

Envoyé par Orda80

Dans votre exemple quel est le délimiteur ?

**Orda80** · 11/12/2019, 13h33

mon délimiteur est "///"

Invité · 11/12/2019, 13h39

Envoyé par Orda80

mon délimiteur est "///"

OK, auriez-vous un fichier modèle sans données confidentielles à mettre en ligne. Je pense qu'il vous faut passer par les méthodes Copy-Paste, mais auparavant il vous faut repérer les ranges entre vos délimiteurs. En fait la matrice devrait contenir la position des caractères début et de fin des parties à copier pour ensuite utiliser un SetRange.

**Orda80** · 11/12/2019, 14h07

Merci Eric, je pense aussi, mais je ne suis pas très douée en VBA.

Voici un document Word avec les délimiteurs.

Invité · 11/12/2019, 16h23

Envoyé par Orda80

A adapter et à tester :

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
 
 
Sub Test2()
 
Dim DocEnCours As Document, NouveauDoc As Document
Dim MatriceRanges() As Variant
Dim I As Long, IndexMatrice As Long, CaractereDebut As Long
Dim StrFilename As String
 
     Set DocEnCours = ActiveDocument
     With DocEnCours
 
          IndexMatrice = 0
          CaractereDebut = 1
          StrFilename = "AAA"
 
          For I = 1 To .Paragraphs.Count
 
              If InStr(1, .Paragraphs(I).Range, "///", vbTextCompare) > 0 Then
                 .Paragraphs(I - 1).Range.Select
                 Selection.EndKey unit:=wdLine
                 Selection.HomeKey unit:=wdStory, Extend:=wdExtend
                 ReDim Preserve MatriceRanges(1, IndexMatrice)
                 MatriceRanges(1, IndexMatrice) = Selection.Characters.Count
 
                 If IndexMatrice > 0 Then
                    MatriceRanges(0, IndexMatrice) = CaractereDebut
                 End If
 
                 .Paragraphs(I + 1).Range.Select
                 Selection.HomeKey unit:=wdLine
                 Selection.HomeKey unit:=wdStory, Extend:=wdExtend
                 CaractereDebut = Selection.Characters.Count
 
                 IndexMatrice = IndexMatrice + 1
               End If
          Next I
 
 
          For IndexMatrice = LBound(MatriceRanges, 2) To UBound(MatriceRanges, 2)
 
              ' Recherche du 1er caractère
              Selection.HomeKey unit:=wdStory, Extend:=wdExtend
              Selection.SetRange MatriceRanges(0, IndexMatrice), MatriceRanges(1, IndexMatrice)
 
              Selection.Range.Copy
              Set NouveauDoc = Documents.Add
              With NouveauDoc
                   .Range.Paste
                   .SaveAs ThisDocument.Path & "\" & StrFilename & Format(IndexMatrice + 1, "000")
                   .Close True
              End With
              Set NouveauDoc = Nothing
 
          Next IndexMatrice
 
     End With
 
     Set DocEnCours = Nothing
 
 
End Sub

**Orda80** · 11/12/2019, 17h21

Merci Eric pour l'aide.
j'ai un message d'erreur qui s'affiche que je ne sais pas comment le gérer ...

Erreur inexécution 5941: Le membre de la collection requis n'existe pas

Invité · 11/12/2019, 17h25

Envoyé par Orda80

j'ai un message d'erreur qui s'affiche que je ne sais pas comment le gérer ... "Erreur inexécution 5941: Le membre de la collection requis n'existe pas"

As-tu essayé sur le document que tu m'as envoyé ? C'est là que tu as le problème ?
Sinon, dans le document testé, le dernier /// à la fin du document est important.
Le programme s'arrête là où il constate une erreur, et met la ligne de code en jaune. En passant la souris sur les variables, tu peux voir la valeur des variables.

**Orda80** · 11/12/2019, 17h57

Oui j'ai testé sur le même document, j'ai changé le document, et j'ai toujours même erreur.

Invité · 11/12/2019, 18h00

Envoyé par Orda80

Oui j'ai testé sur le même document, j'ai changé le document, et j'ai toujours même erreur.

Le programme s'arrête sur quelle ligne ?
Certains des paramètres sont propres à mon poste, les as-tu bien corrigés sur ton poste ?

**Orda80** · 11/12/2019, 18h34

il fait la première boucle "for" plusieurs fois, et il affiche le message d'erreur avant de sortir de la boucle je pense.

Invité · 11/12/2019, 19h15

Envoyé par Orda80

Y a-t-il une ligne vide après le dernier /// ?
Chez moi, tout fonctionne correctement. Peux-tu faire une capture d'écran sur la partie de code qui plante ?

**Orda80** · 11/12/2019, 20h29

j'ai supprimé toutes les lignes après "///", et j'ai exécuté le code toujours le même message, je t'ai fait une capture d'écran de la ligne qui provoque le message d'erreur, le message s'affiche quand la boucle arrive à la dernière ligne.

Nom : message d'erreur.PNG
Affichages : 412
Taille : 38,4 Ko