Discussion :

[leski77]

Bonjour à tous,

J'ai un problème avec une macro qui fait un publipostage à partir de données sous excel vers un modèle word.
Je souhaiterait obtenir un 1 fichier par ligne excel et l'enregistrer sous le nom de la colonne A. (ex: si ma cellule A1 =Paris alors mon fichier s'enregistre sous le nom "Paris")

Est-ce possible?

Voici ma macro:

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
54
55
56
Option Explicit
 
Public Const wdDefaultFirstRecord = 1
Public Const wdDefaultLastRecord = -16
 
 
Sub Publipostage()
Dim Base As String, Model As String, Fiche As String, Rep As String
Dim WordApp As Object ' Word.Application
Dim WordDoc As Object ' Word.Document
 
    Application.ScreenUpdating = False
 
    Base = ActiveWorkbook.Path & "\Liste LignesTEST.xlsm"
    Model = ActiveWorkbook.Path & "\Fiche modèle ADSL.docx"
    Rep = ActiveWorkbook.Path & "\Fiches ADSL\"
    If Not ExisteRep(Rep) Then MkDir Rep
 
 
 
    ' Mise à jour du fichier de données Excel
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="D:\MACRO\Liste LignesTEST.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
 
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False
    Set WordDoc = WordApp.Documents.Open(Model, ReadOnly:=False)
    With WordDoc.MailMerge
    'Ouvre la base
        .OpenDataSource Name:=Base, Connection:="Driver={Microsoft Excel Driver (*.xls)};" & _
            "DBQ=" & Base & "; ReadOnly=True;", SQLStatement:="SELECT * FROM [ADSL$]"
        .suppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
    'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
    Fiche = Rep & "Fiche ADSL_" & Range("$A2")
    WordDoc.Application.ActiveDocument.SaveAs Fiche
    'WordApp.Application.Quit
    WordDoc.Close
    WordApp.Quit
    Application.ScreenUpdating = True
    MsgBox "Fiches ADSL créées"
    'Ouvre le répertoire
    Shell "c:\windows\explorer.exe D:\MACRO\Fiches ADSL", vbNormalFocus
End Sub
 
 
Function ExisteRep(Model As String) As Boolean
    On Error Resume Next
    ExisteRep = GetAttr(Model) And vbDirectory
End Function

Cordialement,

[leski77]

Bonjour à tous,

Je ne trouve toujours pas la solution, pourriez vous m'aider.

Cordialement,

[78chris]

Bonjour

La solution la plus simple est de découper le document unique résultant à chaque saut de section.

Il doit y avoir des codes dans la section Word je crois.

[leski77]

Bonjour,

J'ai fait autrement j'ai créé un bouton par ligne.

Cordialement,