Discussion :

[J-yvesR]

Bonjour à tous,

J'ai un petit problème avec une macro Word.
A partir d'un fichier word de Publipostage et du fichier Excel qui a permis de l'alimenter, je dois créer autant de fichiers qu'il y a de lignes dans le fichier Excel.
Pour chaque ligne de mon fichier Excel, il y a 4 pages dans mon fichier Word.

J'ai trouvé une macro qui faisait le découpage, mais je dois récupérer le nom, le prénom et le matricule de l'agent dans le fichier Excel pour le nommage des fichiers ainsi créé.

J'ouvre mon fichier Excel, mais je ne sais pas comment activer le fichier Excel et aller récupérer les cellules qui m'intéressent dans le fichier Excel.

Merci d'avance pour votre aide!


Voici la 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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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
' définition du fichier et du répertoire du fichier Excel à lire
Dim Fichier As String, Repertoire As String
Dim AppXl As Excel.Application
Dim Wb As Excel.Workbook
' variables pour nom de fichiers
Dim Matricule As String, Nomusuel As String, Prenom As String
 
Const DecouperEn As Integer = 4
 
    Application.ScreenUpdating = False
 
    NomDocDepart = ActiveDocument.Name
    Dossier = ActiveDocument.Path
    DossierSauvegarde = Dossier & Application.PathSeparator & "EIA - Fusion"
    VerifDossier (DossierSauvegarde)
    ' Gestion du fichier Excel
    Repertoire = ActiveDocument.Path
    Fichier = "result6.xls"
 
    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
 
    'ouverture classeur Excel
    Set AppXl = CreateObject("Excel.Application")
    AppXl.Visible = True 'mettre False pour qu'Excel reste masqué
    Set Wb = AppXl.Workbooks.Open(Repertoire & "\" & Fichier)
 
    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
 
        AppXl.Workbooks.Activate (Repertoire & "\" & Fichier)
 
        Nomuse = Worksheets("result6").Cells(2, i + 1)
        Prenom = Worksheets("result6").Cells(3, i + 1)
        Matricule = Worksheets("result6").Cells(4, i + 1)
 
        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
        Wb.Sheets("result6").Range ("A1:G10")
        ActiveDocument.SaveAs FileName:=Matricule + " - " + Nomuse + " - " + Prenom + _
                    " - " + NumeroDoc + Right(NomDocDepart, 8), 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

[aalex_38]

Bonjour,

A mon avis, cette ligne n'est pas correcte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

AppXl.Workbooks.Activate (Repertoire & "\" & Fichier)

Tu as déja défini ton classeur avec wb, si tu veux qu'il soit actif :

Wb.activate

devrait suffire, mais il n'est pas ncr de l'activer, tu peux modifier les lignes en dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Nomuse = wb.Worksheets("result6").Cells(2, i + 1)
Prenom = wb.Worksheets("result6").Cells(3, i + 1)
Matricule = wb.Worksheets("result6").Cells(4, i + 1)

[J-yvesR]

Merci pour la réponse!

Effectivement la ligne :
AppXl.Workbooks.Activate (Repertoire & "\" & Fichier)
faisait parti de mes tests qui ne fonctionnaient pas.

Je m'en suis finalement sorti en utilisant les commandes suivantes :

Set Wb = AppXl.ActiveWorkbook
'Récupération de la feuille par défaut
Set wsExcel = Wb.ActiveSheet

[Heureux-oli]

Salut,

Dans un tuto sur DVP, il y a une explication pour faire un fichier par ligne !
Pas besoin de découper, c'est fait un par un.

http://heureuxoli.developpez.com/off...ipostage/#L7-G