Découpage de fichier word

Marsh Posté le 03-08-2006 à 14:15:39

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.

Reply

Marsh Posté le 03-08-2006 à 14:15:39

Reply

Marsh Posté le 03-08-2006 à 14:34:28

tout en sendkeys ca marche ?

Reply

Marsh Posté le 03-08-2006 à 14:39:17

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

Message cité 1 fois

Reply

Marsh Posté le 03-08-2006 à 14:40:53

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.

Reply

Marsh Posté le 03-08-2006 à 15:04:22

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....

Reply

Marsh Posté le 04-08-2006 à 09:25:57

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.

Reply

Marsh Posté le 04-08-2006 à 11:31:59

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

Reply

Marsh Posté le 04-08-2006 à 21:21:23

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

Reply

Marsh Posté le 05-08-2006 à 01:33:35

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

Reply

Marsh Posté le 05-08-2006 à 08:15:20

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

Reply

Marsh Posté le 05-08-2006 à 08:15:20

Reply

Marsh Posté le 11-06-2013 à 17:38:40

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

Reply

Découpage de fichier word

Sujets relatifs:

Leave a Replay