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

Messages postés
3
Date d'inscription
mercredi 11 janvier 2012
Dernière intervention
12 janvier 2012
- 11 janv. 2012 à 09:00 - Dernière réponse :
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 12 janv. 2012 à 14:28
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.
Afficher la suite 

Votre réponse

8 réponses

Meilleure réponse
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 11 janv. 2012 à 13:48
3
Merci
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)

Merci cs_Jack 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 88 internautes ce mois-ci

Commenter la réponse de cs_Jack
Messages postés
14299
Date d'inscription
vendredi 14 mars 2003
Dernière intervention
16 novembre 2018
- 11 janv. 2012 à 13:01
0
Merci
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
Commenter la réponse de NHenry
Messages postés
3
Date d'inscription
mercredi 11 janvier 2012
Dernière intervention
12 janvier 2012
- 11 janv. 2012 à 20:17
0
Merci
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?
Commenter la réponse de closej
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 11 janv. 2012 à 23:34
0
Merci
Voir fonction Replace
Commenter la réponse de cs_Jack
Messages postés
3
Date d'inscription
mercredi 11 janvier 2012
Dernière intervention
12 janvier 2012
- 12 janv. 2012 à 01:01
0
Merci
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)
Commenter la réponse de closej
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 12 janv. 2012 à 13:45
0
Merci
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.
Commenter la réponse de cs_Jack
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 12 janv. 2012 à 13:47
0
Merci
Voir aussi <cette source> utilisable en VBA.
Commenter la réponse de cs_Jack
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Dernière intervention
28 août 2015
- 12 janv. 2012 à 14:28
0
Merci
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
Commenter la réponse de cs_Jack

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.