découper un document Word en autant de fichier qu'il n'y as de titre1Résolu

Question

Bonjour, 
Voila, je suis novice en programmation et suis dès lors à la recherche de quelqu'un qui pourrait m'aider à réaliser ce qui suit:
Je souhaiterai découper un document Word contenant des chapitres avec un style titre1 et un corps de texte, en plusieurs fichiers qu'il n'y as de titre1, et cerise sur le gâteau nommer les fichiers découpés par le titre1.

cs_Jack · Accepted Answer

Salut

Exercice intéressant.
En fait, comme toujours, il faut décomposer ce que tu as à faire :
- Parcourir le document à la recherche du format "Titre 1"
- Mémoriser le début et la fin de cette partie, sachant que le début sera le début du coument ou la fin de la partie précédente
- Transférer le contenu sélectionné dans un nouveau document pour l'enregistrer

J'ai commencé par enregistrer une macro pendant que j'appliquais le style "Titre 1" à une ligne.
Le code m'a donné les mots clés comme .Styles
J'ai alors regardé l'aide et l'exemple pour facilement trouver comment détecter ce style.
Ensuite, pour connaitre le début et la fin d'une partie du texte, suffit de s'adresser à Range. Là aussi, l'aide apporte des réponses.
Enfin, comme l'enregistrement ne peut se faire que sur un document, il fallait transférer le texte et son format dans un nouveau document, puis l'enregistrer sous le nom du chapitre trouvé lors des recherches de "Titre 1". Là aussi, l'enregistreur de macro fourni ce qu'il faut.

Je n'ai pas l'habitude de fournir du code tout fait, mais ça m'a amusé de le faire.
Le résultat n'est pas important, il faut que tu comprennes ce code pour y apporter ta touche et savoir le refaire ou l'adapter.

Sub xxx()
    Dim Para        As Paragraph
    Dim sTitre      As String
    Dim oRange      As Range
    Dim oDocument   As Document
    With ActiveDocument
        sTitre = "Sans titre"
        Set oRange = .Range(0, 0)
        For Each Para In .Paragraphs
            If Para.Style = "Titre 1" Then
                If Para.Range.Start > 0 Then
                    oRange.End = Para.Range.Start - 1
                    ' Ici le code pour enregistrer le contenu de oRange
                    '   avec sTitre comme nom de fichier
                    ' genre (à approfondir) :
                    Set oDocument = New Document
                    With oDocument
                        .Range.Start = 0
                        .Range.End = oRange.End - oRange.Start
                        .Range.FormattedText = oRange.FormattedText
                        ChangeFileOpenDirectory "C:\mon répertoire qui va bien"
                        .SaveAs FileName:=sTitre, _
                                          FileFormat:=wdFormatDocument, _
                                          LockComments:=False, _
                                          Password:="", _
                                          AddToRecentFiles:=True, _
                                          WritePassword:="", _
                                          ReadOnlyRecommended:=False, _
                                          EmbedTrueTypeFonts:=False, _
                                          SaveNativePictureFormat:=False, _
                                          SaveFormsData:=False, _
                                          SaveAsAOCELetter:=False
                        .Close
                    End With
                    Set oDocument = Nothing
                End If
                ' Mémo des nouvelles infos
                sTitre = Para.Range.Text
                If Right$(sTitre, 1) = vbCr Then
                    sTitre = Left$(sTitre, Len(sTitre) - 1)
                End If
                oRange.Start = Para.Range.Start
                oRange.End = oRange.Start
            End If
        Next Para
        If oRange.End <> .Range.End Then
            ' Enregistre dernière partie
            oRange.End = .Range.End
            Set oDocument = New Document
            With oDocument
                .Range.Start = 0
                .Range.End = oRange.End - oRange.Start
                .Range.FormattedText = oRange.FormattedText
                ' Ici le code pour enregistrer le contenu de oRange
                '   avec sTitre comme nom de fichier
                ' genre (à approfondir) :
                ChangeFileOpenDirectory "C:\mon répertoire qui va bien"
                .SaveAs FileName:=sTitre, _
                                  FileFormat:=wdFormatDocument, _
                                  LockComments:=False, _
                                  Password:="", _
                                  AddToRecentFiles:=True, _
                                  WritePassword:="", _
                                  ReadOnlyRecommended:=False, _
                                  EmbedTrueTypeFonts:=False, _
                                  SaveNativePictureFormat:=False, _
                                  SaveFormsData:=False, _
                                  SaveAsAOCELetter:=False
                .Close
            End With
            Set oDocument = Nothing
        End If
    End With
End Sub
Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

NHenry · Answer

Bonjour, 

Sur quel point exactement tu bloques ?
Car dans le doute, personne ne peut répondre clairement.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, ce lien ou encore celui-ci[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

closej · Answer

Un Grand Merci Jack pour ta réponse rapide.
le code que tu m'as envoyé fonctionne très bien.
Cependant, le titre contient des "." ou ":" comme cette exemple:
"B. 3.11. LEXIQUE: ? POSTE"
Je souhaiterai qu'il enregistre le fichier comme ceci, sans le texte après le dernier ".": 
"B_3_11.doc" 
Tu penses que ses réalisable?

cs_Jack · Answer

Voir fonction Replace

closej · Answer

j'ai écris ceci mais il coince je dois supprimer le début du document qui contient un corps de texte.

Function formatnom(st As String) As String

Dim l As Integer
Dim i As Integer

l = Len(st)
'Debug.Print l
 While (l > 0) And (Mid(st, l, 1) <> ".")
' Debug.Print l
'If l = 0 Then
' st = "Sans titre"
'Else
l = l - 1
Wend
l = l - 1
st = Left(st, l)
st1 = ""
For i = 1 To l
If (Mid(st, i, 1) ".") Or (Mid(st, i, 2) ". ") Then
st1 = st1 & "_"
Else
st1 = st1 & Mid(st, i, 1)
End If
Next i

formatnom = st1

 End Function

'.SaveAs FileName:=formatnom(sTitre)

cs_Jack · Answer

As-tu regardé l'aide de la fonction Replace ?
C'est hyper simple !

PS : Mieux vaut éviter le nom de variable L minuscule car elle se confond de trop avec le chiffre 1; sujet à bug.

cs_Jack · Answer

Voir aussi <cette source> utilisable en VBA.

cs_Jack · Answer

Pour ce qui est de la transformation de 
"B. 3.11. LEXIQUE: ? POSTE"
en
"B_3_11.doc"
il va falloir passer par la fonction Split qui te permettra de séparer chaque texte avec le séparateur "."
Une fois que tu auras ces textes dans un tableau, il te suffira de reconstruire une chaine en concaténant (ajoutant) les éléments les uns derrière les autres, sauf le dernier.
Voir l'aide de Split, For-Next, LBound, UBound

Découper un document Word en autant de fichier qu'il n'y as de titre1

8 réponses

Votre réponse

Discussions similaires