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

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Découpe fichier Word toute les X pages

 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Découpe fichier Word toute les X pages

n°2131116
Plouf
Posté le 13-03-2012 à 12:29:11  profilanswer
 

Bonjour,
Je viens vous demander votre aide, car mes faibles compétences en VB ne me suffise pas à résoudre mon soucis.
 
Je cherche à créer une macro pour dissocier le résultat d'un publipostage.
- Je voudrais que cette macro me demande au lancement, le nombre de page dont est composé le fichier initial (c'est a dire que mon publipostage concerne un fichier qui fais parfois 7 pages, et parfois 10). Donc j'ai besoin d'initialiser cette valeur au lancement de la macro.
 
J'ai trouvé le nécéssaire pour dissocier mon fichier (voir ci-dessous), mais je n'arrive pas a couper ce fichier toutes les 10 pages.
Pouvez vous m'aider avec ce petit détail s'il vous plait ?
Sub DissocierPage()
   Application.Browser.Target = wdBrowsePage    
   For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages" )      
      ActiveDocument.Bookmarks("\page" ).Range.Copy
      Documents.Add
      Selection.Paste
      Selection.TypeBackspace      
      ChangeFileOpenDirectory "C:"
      DocNum = DocNum + 1
      ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
      ActiveDocument.Close
      Application.Browser.Next      
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges      
End Sub

 
- J'ai un deuxième petit soucis. Je voudrais renommer le fichier par un nom qui se trouve dans mon document (emplacement fixe une fois le découpage terminé), mais ce nom se trouve dans une zone de texte. J'ai trouvé un autre code pour cela (voir ci-dessous), mais encore une fois, je ne sais pas l'adapter à mon besoin.
Sub nom()
Dim nom
nom = ActiveDocument.Paragraphs(12).Range.Words(5) '5e mot de la 12e ligne (exemple)
ActiveDocument.SaveAs FileName:= "c:\" & nom & ".doc
End Sub

 
Merci beaucoup du temps que vous prendrez à me repondre.


Message édité par Plouf le 13-03-2012 à 12:30:58
mood
Publicité
Posté le 13-03-2012 à 12:29:11  profilanswer
 

n°2131130
kiki29
Posté le 13-03-2012 à 13:39:32  profilanswer
 

Salut, voir sur http://support.microsoft.com/kb/306348/fr
Sinon à tester et adapter
 

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
Dim NbPages As Long
Const DecouperEn As Integer = 10
 
    Application.ScreenUpdating = False
 
    NomDocDepart = ActiveDocument.Name
    NbPages = ActiveDocument.Content.ComputeStatistics(wdStatisticPages)
 
    Dossier = ActiveDocument.Path
    DossierSauvegarde = Dossier & "\" & "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
 
Private 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


---------------
Myanmar 90/91 : http://gadaud.gerard.free.fr/publi [...] index.html

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

  Découpe fichier Word toute les X pages

 

Sujets relatifs
Help comparaison de deux fichier perlAffichage d'une recherche + système de pages
Comment peut-on lire un fichier pdf en php?[Résolu]Copie d'une cellule d'un fichier à l'autre
Détruire un fichier après qu'il ait été téléchargé[Résolu] Quote Execute + Find pour le listing de fichier
Rechercher un fichier texte puis copier le contenu dans Excelpb liste chainée et lecture de fichier C
Mise a jour automatique fichier exceldeveloppement application partage fichier avec metadata en java
Plus de sujets relatifs à : Découpe fichier Word toute les X pages


Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR