1. #1
    Nouveau Candidat au Club
    Femme Profil pro
    Ressources humaines
    Inscrit en
    avril 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 37
    Localisation : France, Alpes Maritimes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Ressources humaines

    Informations forums :
    Inscription : avril 2017
    Messages : 2
    Points : 1
    Points
    1

    Par défaut Publipostage et mise en forme

    Bonjour,
    J'ai un soucis avec une macro qui ne me garde po ma mise en forme

    J'ai un publipostage qui fait 220 pages, je souhaite le séparer toutes les 10 pages. J'ai donc copié honteusement une macro sur un forum :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    Sub EclateDoc()
    Dim objFso
    Set objFso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    documentAEclater = ActiveDocument.Name
    If Err.Number <> 0 Then
    MsgBox "Le document à éclater n'est pas ouvert !" & Chr(10) & "Abandon !", vbExclamation, "Eclater document word"
    End
    End If
    DirSvg = ActiveDocument.FullName
    For i = Len(DirSvg) To 1 Step -1
    If Mid(DirSvg, i, 1) = "\" Then
    DirSvg = Left(DirSvg, i - 1)
    Exit For
    End If
    Next
    If Not objFso.folderexists(DirSvg & "\DocEclaté") Then
    objFso.createFolder (DirSvg & "\DocEclaté")
    End If
    Selection.GoTo what:=wdGoToLine, which:=wdGoToAbsolute, Count:=1
    Application.Browser.Target = wdBrowsePage
    '---------------------------------
    ' Nombre de page du document éclaté
    '---------------------------------
    Separation = 10
    '---------------------------------
    On Error GoTo 0
     
    cptSeparation = 0
    Pages = ActiveDocument.BuiltInDocumentProperties("Number of Pages")
    For i = 1 To Pages
    Documents(documentAEclater).Activate
    Set CurrentPage = ActiveDocument.Bookmarks("\page").Range
    CurrentPage.Copy
    cptSeparation = cptSeparation + 1
    If cptSeparation = 1 Then
    Documents.Add
    DocumentEnCreation = ActiveDocument.Name
    End If
    Documents(DocumentEnCreation).Activate
    Selection.Paste
    If cptSeparation = Separation Then
    'Selection.TypeBackspace
    DocNum = DocNum + 1
    ActiveDocument.SaveAs FileName:=DirSvg & "\DocEclaté\test_" & DocNum & ".doc"
    ActiveDocument.Close
    cptSeparation = 0
    End If
    Documents(documentAEclater).Activate
    Application.Browser.Next
    Next i
    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
    End Sub
    Tout fonctionne sauf que ma mise en page est vraiment mais vraiment moche ^^
    Est-ce que quelqu'un pourrait m'aider?

    Merci par avance.

  2. #2
    Nouveau Candidat au Club
    Femme Profil pro
    Ressources humaines
    Inscrit en
    avril 2017
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 37
    Localisation : France, Alpes Maritimes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Ressources humaines

    Informations forums :
    Inscription : avril 2017
    Messages : 2
    Points : 1
    Points
    1

    Par défaut

    J'ai trouvé ... Je note si besoin pour les suivants :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    Sub TestPublipost()
    ' Déclaration des variables
    Dim iR As Integer
    Dim i As Integer
    Dim oDoc As Document
    Dim DocName As String
    Dim oDS As MailMergeDataSource
     
    ' Affectation des objets
    Set oDoc = ActiveDocument
    Set oDS = oDoc.MailMerge.DataSource
     
    iR = oDoc.MailMerge.DataSource.RecordCount
    Debug.Print iR
    For i = 1 To iR
        With oDoc.MailMerge
            'Définition du premier et dernier enregistrement
            .DataSource.FirstRecord = i
     
            .DataSource.LastRecord = i
            ' Envoi des données dans un nouveau document
            .Destination = wdSendToNewDocument
            ' Exécution du publipostage
            .Execute
            ' Actualisation de l'enregistrement pour la sauvegarde
            .DataSource.ActiveRecord = i
            'Utilisation de deux champs pour obtenir le nom du document
            DocName = .DataSource.DataFields(2).Value
            DocName = DocName & "-" & .DataSource.DataFields(3).Value
            Debug.Print DocName; i
        End With
        ' Sauvegarde du document publiposté
        With ActiveDocument
            .SaveAs "c:\temp\" & DocName & ".doc"
            .Close
        End With
    Next i
    End Sub

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [CR] mise en forme d'un champs texte en fonction des données
    Par niPrM dans le forum SAP Crystal Reports
    Réponses: 6
    Dernier message: 29/06/2004, 12h57
  2. Réponses: 2
    Dernier message: 28/06/2004, 18h27
  3. mise en forme rapide d'applets
    Par appletj dans le forum Applets
    Réponses: 11
    Dernier message: 03/06/2004, 14h28
  4. Mise en forme HTML
    Par Regis.C dans le forum XML/XSL et SOAP
    Réponses: 5
    Dernier message: 25/04/2004, 12h55
  5. Mise en forme fichier avant Import
    Par jeff37 dans le forum Langage SQL
    Réponses: 3
    Dernier message: 21/04/2004, 16h16

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo