Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
4005 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Découpage de fichier word

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Découpage de fichier word

n°1418916
acorsa
Posté le 03-08-2006 à 14:15:39  profilanswer
 

Bonjour!
Je voulais savoir si vous connaissez le moyen de découper un document word en plusieurs petits (programmer une macro ou le nom d'un logiciel qui fait ça...)
En fait j'ai des documents de grandes tailles (environ 300 pages) et je souhaiterai les dicviser en plusieurs documents d'une vingtaines de pages.
 
Merci.

mood
Publicité
Posté le 03-08-2006 à 14:15:39  profilanswer
 

n°1418932
jpcheck
Pioupiou
Posté le 03-08-2006 à 14:34:28  profilanswer
 

tout en sendkeys ca marche ?

n°1418936
acorsa
Posté le 03-08-2006 à 14:39:17  profilanswer
 

euh...au risque de passer pour un boulet en prog, je ne vois pas comment sendkeys pourrait m'aider...

Message cité 1 fois
n°1418937
jpcheck
Pioupiou
Posté le 03-08-2006 à 14:40:53  profilanswer
 

acorsa a écrit :

euh...au risque de passer pour un boulet en prog, je ne vois pas comment sendkeys pourrait m'aider...


tu  sélectionnes via du vb un nombre de page prédéfini.
tu fais un couper Ctrl X
nouveau fichier coller Ctrl N Ctrl V
etc.

n°1418953
acorsa
Posté le 03-08-2006 à 15:04:22  profilanswer
 

ok, là g compris ms mon but est de faire ça sur un grand nombre de fichiers.Et je ne peux faire ça que sur des fichiers ouverts....

n°1419422
rufo
Pas me confondre avec Lycos!
Posté le 04-08-2006 à 09:25:57  profilanswer
 

en asp, j'avais fait ça via OLE. Tu ouvres une instance de Word avec le fichier que tu veux découper. Nous, comme on ne pouvait pas utiliser sendkey, on détectait le début et la fin d'une page, on sélectionait le tout et on copiait la sélection dans un nouveau fichier...A la fin, on refermait word.

n°1419531
acorsa
Posté le 04-08-2006 à 11:31:59  profilanswer
 

J'ai mis plus d'explications là: http://forum.hardware.fr/hardwaref [...] 4660-1.htm

n°1420080
kiki29
Posté le 04-08-2006 à 21:21:23  profilanswer
 

Vite fait sur le gaz, à améliorer  


Option Explicit
 
Sub DecoupageDoc()
Dim NomDocDepart As String
Dim i As Long, j As Long
Dim Termine As Boolean
Dim NumeroDoc As String, PgDepart As Long
Dim Dossier As String, DossierSauvegarde As String
Const DecouperEn As Integer = 6
     
    Application.ScreenUpdating = False
     
    NomDocDepart = ActiveDocument.Name
     
    Dossier = ActiveDocument.Path
    DossierSauvegarde = Dossier & Application.PathSeparator & "Charcuterie"
    VerifDossier (DossierSauvegarde)
     
    Selection.EndKey Unit:=wdStory
    Selection.HomeKey Unit:=wdStory
     
    i = 0
    Termine = False
    ChangeFileOpenDirectory DossierSauvegarde
 
    Do While True
        i = i + 1
         
        NumeroDoc = Trim(Str(i))
        Do While Len(NumeroDoc) < 4
            NumeroDoc = "0" + NumeroDoc
        Loop
     
        PgDepart = Selection.Range.Start
        For j = 1 To DecouperEn
            Application.Browser.Next
        Next
         
        If Selection.Range.Start = PgDepart Then
            Termine = True
            Selection.EndKey Unit:=wdStory
        Else
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
        End If
         
        ActiveDocument.Range(Start:=PgDepart, End:=Selection.Range.Start).Copy
        Documents.Add Template:="Normal", NewTemplate:=False
        Selection.Paste
         
        ActiveDocument.SaveAs FileName:=Left(NomDocDepart, Len(NomDocDepart) - 4) + _
            "_" + NumeroDoc + ".doc", FileFormat:=wdFormatDocument
        ActiveDocument.Close
         
        Documents(NomDocDepart).Activate
        If Termine Then Exit Do
         
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
    Application.ScreenUpdating = True
End Sub
 
Sub VerifDossier(ByVal DossierSauvegarde As String)
On Error GoTo erreur
    ChDir DossierSauvegarde
    Exit Sub
erreur:
    If Err.Number = 76 Then
        MkDir (DossierSauvegarde)
        Resume Next
    End If
End Sub


Message édité par kiki29 le 05-06-2007 à 03:16:08
n°1420241
kiki29
Posté le 05-08-2006 à 01:33:35  profilanswer
 

Une variante


Sub Decoupage()
Dim NomDocDepart As String
Dim i As Long, j As Long
Dim NumeroDoc As String, PgDepart As Long
Dim Dossier As String, DossierSauvegarde As String
Dim NbPages As Long, NbCoupes As Integer, PagesRestantes As Integer
 
Const DecouperEn As Integer = 7
     
    Application.ScreenUpdating = False
     
    NomDocDepart = ActiveDocument.Name
    Dossier = ActiveDocument.Path
    DossierSauvegarde = Dossier & Application.PathSeparator & "Charcuterie"
    VerifDossier (DossierSauvegarde)
     
    Selection.EndKey Unit:=wdStory
    Selection.HomeKey Unit:=wdStory
   
    NbPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    NbCoupes = NbPages \ DecouperEn
    PagesRestantes = NbPages Mod DecouperEn
     
    If PagesRestantes = NbPages Then Exit Sub
     
    ChangeFileOpenDirectory DossierSauvegarde
 
    For i = 1 To NbCoupes
        NumeroDoc = ((i - 1) * DecouperEn + 1) & "_" & (i * DecouperEn)
         
        PgDepart = Selection.Range.Start
        For j = 1 To DecouperEn
            Application.Browser.Next
        Next
         
        If Selection.Range.Start = PgDepart Then Selection.EndKey Unit:=wdStory
         
        ActiveDocument.Range(Start:=PgDepart, End:=Selection.Range.Start).Copy
        Documents.Add Template:="Normal", NewTemplate:=False
        Selection.Paste
         
        ActiveDocument.SaveAs FileName:=Left(NomDocDepart, Len(NomDocDepart) - 4) + _
                    "_" + NumeroDoc + ".doc", FileFormat:=wdFormatDocument
        ActiveDocument.Close
         
        Documents(NomDocDepart).Activate
    Next
     
    If PagesRestantes > 0 Then
        NumeroDoc = (NbPages - PagesRestantes + 1) & "_" & NbPages
         
        PgDepart = Selection.Range.Start
        For j = 1 To PagesRestantes
           Application.Browser.Next
        Next
        Selection.EndKey Unit:=wdStory
     
        ActiveDocument.Range(Start:=PgDepart, End:=Selection.Range.Start).Copy
        Documents.Add Template:="Normal", NewTemplate:=False
        Selection.Paste
         
        ChangeFileOpenDirectory DossierSauvegarde
        ActiveDocument.SaveAs FileName:=Left(NomDocDepart, Len(NomDocDepart) - 4) + _
                    "_" + NumeroDoc + ".doc", FileFormat:=wdFormatDocument
        ActiveDocument.Close
        Documents(NomDocDepart).Activate
    End If
     
    Application.ScreenUpdating = True
End Sub
 
Sub VerifDossier(ByVal DossierSauvegarde As String)
On Error GoTo erreur
    ChDir DossierSauvegarde
    Exit Sub
erreur:
    If Err.Number = 76 Then
        MkDir (DossierSauvegarde)
        Resume Next
    End If
End Sub


Message édité par kiki29 le 05-06-2007 à 03:17:02
n°1420280
kiki29
Posté le 05-08-2006 à 08:15:20  profilanswer
 

Enfin une autre pour la route : page par page


Option Explicit
 
Sub DecoupagePageParPage()
Dim NomDocDepart As String
Dim i As Long
Dim Dossier As String, DossierSauvegarde As String
Dim NumDoc As Long, NbPages As Long
 
    NomDocDepart = ActiveDocument.Name
    Dossier = ActiveDocument.Path
    DossierSauvegarde = Dossier & Application.PathSeparator & "Charcuterie"
    VerifDossier (DossierSauvegarde)
     
    Application.ScreenUpdating = False
    Application.Browser.Target = wdBrowsePage
    NbPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
     
    ChangeFileOpenDirectory DossierSauvegarde
 
    For i = 1 To NbPages
       
      ActiveDocument.Bookmarks("\page" ).Range.Copy
      Documents.Add
      Selection.Paste
       
      NumDoc = NumDoc + 1
       
      ActiveDocument.SaveAs FileName:=Left(NomDocDepart, Len(NomDocDepart) - 4) + _
            "_" + CStr(NumDoc) + ".doc", FileFormat:=wdFormatDocument
      ActiveDocument.Close
 
      Application.Browser.Next
    Next i
     
    Application.ScreenUpdating = True
    'ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
 
Sub VerifDossier(ByVal DossierSauvegarde As String)
On Error GoTo erreur
    ChDir DossierSauvegarde
    Exit Sub
erreur:
    If Err.Number = 76 Then
        MkDir (DossierSauvegarde)
        Resume Next
    End If
End Sub


Message édité par kiki29 le 05-06-2007 à 03:17:47
mood
Publicité
Posté le 05-08-2006 à 08:15:20  profilanswer
 

n°2193835
poussinour​s
Posté le 11-06-2013 à 17:38:40  profilanswer
 

Bonjour,
 
Je me permets de faire remonter le sujet car je souhaite une scission également mais bien à chaque saut de page et non aux sauts de section à des fins d'enregistrements.
Est-ce que cela est possible?
 
Je n'y connais vraiment rien en vba malheureusement...
 
Je vous remercie d'avance!
 
Poussinours


Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Découpage de fichier word

 

Sujets relatifs
[Batch DOS] Recupérer le fichier le plus récent.[Résolu]Récupérer le nom d'un fichier à uploader
Ou est enregistré le fichier avec un select * into outfile ?effacer un mot d un fichier en c#
Lire un fichier de propertiesFichier existant javascript
[C#.Net] MaxLength pas supporté dans un fichier .skincreer un fichier en modifiant son contenu , son extension (vbs)
Problème de lecture sur fichier ini.Verification de la presence d'un fichier -> increment de 1 si vrai
Plus de sujets relatifs à : Découpage de fichier word

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.066 secondes

Copyright © 1997-2025 Groupe LDLC (Signaler un contenu illicite / Données personnelles)