Découpage de fichier word

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Découpage de fichier word

acorsa

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.

Publicité

jpcheck

Pioupiou

tout en sendkeys ca marche ?

acorsa

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

Message cité 1 fois

jpcheck

Pioupiou

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.

acorsa

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

rufo

Pas me confondre avec Lycos!

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.

acorsa

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

kiki29

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

kiki29

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

kiki29

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

Publicité

poussinours

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

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 properties	Fichier existant javascript
[C#.Net] MaxLength pas supporté dans un fichier .skin	creer 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

Page générée en 0.049 secondes