Insérer une nouvelle page dans mon document word suivant un modèle avec des signets

[aba_tarn]

Bonjour à tous,

J'ai un soucis avec un publipostage d'access vers Word. J'utilise le code suivant :

Dim MaBD As Database
    Dim MaRequete As Recordset
    'Dim Myrange As Range
   
   
    Dim NbEnreg, i As Integer
    Dim MonTableau As Object
    Dim vnt As Variant
    Dim j As Integer
    
     
    'Vérifie si un élément est choisi dans la liste
      If Me.choix_parcelle.ItemsSelected.Count = 0 Then
        MsgBox "Vous n'avez pas sélectionné de parcelle !", vbCritical, "Opération annulée !"
   Else
 
'confirmer l'impression
   answer = MsgBox("Etes-vous sûr de vouloir exporter la sélection dans Word ?", vbYesNo + vbQuestion, "Confirmer export")
 
   'MsgBox "Etes-vous sûr de vouloir imprimer un courrier pour la sélection ?", vbYesNo + vbQuestion, "Confirmer impression"
 If answer = vbYes Then
    
   'Compte le nombre d'enregistrements dans la requête R_proprietaire_publipostage
   'et arrête la procédure de transfert
   'si la requête ne contient aucun enregistrement
    
     'Création d'une instance de Word et activation de l'application.
    Set MonAppliWord = New Word.Application
   
   'Création de la variable objet Lettre_type représentant
   'le document Word
    Set Lettre_type = MonAppliWord.Documents.Add("C:\BD_travaux_SMBA\Lettre_type.dotx")
    MonAppliWord.Visible = True
        
     
        
    For Each vnt In Me.choix_parcelle.ItemsSelected
    For j = 0 To Me.choix_parcelle.ColumnCount - 6
    
    
    NbEnreg = DCount("[num_parcelle]", "R_proprietaire_publipostage", "id_parcelle like " & Me.choix_parcelle.Column(j + 1, vnt))
   
     'If NbEnreg = 0 Then
        'MsgBox "Aucune parcelle n'a été liée à ce propriétaire !", vbCritical, "Opération annulée !"
        'Exit Sub
    'End If
    
   'Ouvre la base de données en cours et la requête concernée
   
   Set MaBD = CurrentDb()
   Set MaRequete = MaBD.OpenRecordset("SELECT * FROM R_proprietaire_publipostage  WHERE id_parcelle like " & "" & Me.choix_parcelle.Column(j + 1, vnt) & "", dbOpenSnapshot)
    
  
   
   'Positionnement sur le premier enregistrement de la requête
   MaRequete.MoveFirst
  
'Insertion des coordonnées du client
On Error Resume Next
   With Lettre_type.Bookmarks
        .Item("societe").Range.Text = MaRequete.Fields("societe")
        .Item("civilité").Range.Text = MaRequete.Fields("civilité")
        .Item("civilite1").Range.Text = MaRequete.Fields("civilite1")
        .Item("civilite2").Range.Text = MaRequete.Fields("civilite2")
        .Item("nom_jeune_fille").Range.Text = MaRequete.Fields("nom_jeune_fille")
        .Item("nom_usage").Range.Text = MaRequete.Fields("nom_usage")
        .Item("prenom").Range.Text = MaRequete.Fields("prenom")
        .Item("adresse1").Range.Text = MaRequete.Fields("adresse1")
        .Item("adresse2").Range.Text = MaRequete.Fields("adresse2")
        .Item("code_postal").Range.Text = MaRequete.Fields("code_postal")
        .Item("commune").Range.Text = MaRequete.Fields("commune")
        .Item("pays").Range.Text = MaRequete.Fields("pays")
End With
 
   'Création du tableau Word
   'recevant les parcelles des propriétaires
    Set MonTableau = Lettre_type.Tables.Add(Lettre_type.Bookmarks.Item("Debut_parcelle").Range, NbEnreg + 1, 3)
   
'Remplissage de la ligne d'en-tête du tableau
      
    With MonTableau
        .Cell(1, 1).Range.InsertAfter "Commune"
        .Cell(1, 2).Range.InsertAfter "Section"
        .Cell(1, 3).Range.InsertAfter "Numéro"
   
'Mise en forme du tableau
 
        .Rows(1).SetHeight RowHeight:=24, HeightRule:=wdRowHeightAtLeast
        .Rows(1).Cells.VerticalAlignment = wdAlignVerticalCenter
        .Rows(1).Cells.HorizontalAlignment = wdAlignHorizontalCenter
    
'Ajustement des largeurs de colonnes aux dimensions souhaitées
    
        .Columns(1).SetWidth ColumnWidth:=170, RulerStyle:=wdAdjustProportional
        .Columns(2).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustProportional
        .Columns(3).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustProportional
    
    End With
 
'Remplissage du tableau avec les données
'issues de la requête R_proprietaire_publipostage
 
    For i = 1 To NbEnreg
   
   'Parcourt la requête R_proprietaire_publipostage,
   'ajoute les contenus dans les cellules
   
    With MonTableau
      
         .Cell(i + 1, 1).Range.InsertAfter MaRequete!nom_commune
         .Cell(i + 1, 2).Range.InsertAfter MaRequete!section
         .Cell(i + 1, 3).Range.InsertAfter MaRequete!num_parcelle
         
   'Puis Centrage vertical des contenus de cellules de toute la ligne
         
         .Rows(i + 1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
         
   'Alignement de la référence et de la quantité au centre de la cellule
   
         .Cell(i + 1, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
         .Cell(i + 1, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
         
        End With
       
      'Se positionne sur l'enregistrement suivant
       MaRequete.MoveNext
     
    Next i
 
    With Lettre_type.Tables(1)
    
       With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
        End With
        
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
        End With
        
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
        End With
        
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth150pt
        End With
        
        With .Borders(wdBorderHorizontal)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
        End With
        
        With .Borders(wdBorderVertical)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth075pt
        End With
        
    End With
        
     Next j
 
    MaRequete.Close
    MaBD.Close
   
   MonAppliWord.Close
 
    Next vnt
    Set MonAppliWord = Nothing
End If
End If

Ce code était avant next j

 
 
   'Création de la variable objet Lettre_type représentant
   'le document Word
    Set Lettre_type = MonAppliWord.Documents.Add("C:\BD_travaux_SMBA\Lettre_type.dotx")
    MonAppliWord.Visible = True
 

Mais cela ouvrait autant de fichiers word que d'enregistrements, c'est pour cela que je l'ai changé d'endroit mais il faudrait que je puisse créer une nouvelle feuille qui prend base sur mon modèle.dot et que l'enregistrement suivant se mettre sur la feuille suivante.

En gros je ne veux qu'un seul document Word avec autant de pages que d'enregistrements.

Pour le moment j'ai réussi à créer autant de pages word que d'enregistrement à l'aide de ce code :

MonAppliWord.Selection.EndKey Unit:=wdStory
  MonAppliWord.Selection.InsertBreak (wdPageBreak)

J'aimerais définir ma nouvelle page à l'aide de mon modèle

C:\BD_travaux_SMBA\Lettre_type.dotx

avec ses signets. Comment faire?

J'ai essayé de copier la page précédente et de la coller, sans succès je n'y suis pas arrivée. De plus dans la FAQ il y a au moins un message avec le même problème que moi mais malheureusement, il est resté sans réponse... Est-ce la bonne solution? ou existe-t-il d'autres techniques plus faciles?

Merci pour votre aide

[Heureux-oli]

Salut,

C'est pas prendre le problème à l'envers ?

Si tu fais un publipostage, tu as autant de pages que d'enregistrements.
Ce qui te manque, c'est juste une page de garde.
N'est-il pas plus facile d'ajouter une page de garde au document existant, ou le document issu de la fusion à une page de garde ?

[aba_tarn]

Eh bien le problème de mon code c'est que j'ai UN FICHIER par enregistrement et non une page par enregistrement... Qu'est-ce qu'une page de garde?

En fait je ne fait pas réellement un publipostage, je rempli un modèle word avec des données provenant de tables access. Je pense que c'ets de là que vient mon problème, mais je ne vois pas comment ffaire autrement puisqu'il faut que je construise des tableaux contenants des données provenant d'Access.

Si vous voyez une autre solution à mon problème, je suis toute ouie Car ça fait déjà pas mal de temps que je cherche une solution..

[Heureux-oli]

Je ne sais pas de quoi tu pars et vers quoi tu arrives.

As-tu regardé du côté des ressources que nous possédons sur le publipostage.

http://word.developpez.com/cours

Il te reste aussi une possibilité de faire un document principal avec des sous-documents, comme on devrais connaître le nom des fichiers, on peut les ajouter.

C'est à toi de voir.

[aba_tarn]

Oui j'avais déjà regardé à de nombreuses reprises les cours et les ressources. La création d'un document principal avec des sous-documents me parait être une solution, avez vous des informations sur ce sujet, code...

[Heureux-oli]

Si tu mets tous tes documents dans un même répertoire, on peut toujours envisager de parcourir tous les documents pour les insérer dans le document principal.

Par exemple :

Sub testAjoutDoc()
'
' Ajouter la bibliothèque Microsoft Scripting Runtime
'
Dim fso As FileSystemObject
Dim dlg As FileDialog
Dim oFl As File
Dim ofol As Folder
Dim stPath As String
 
 
Set fso = New FileSystemObject
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
dlg.Show
stPath = dlg.SelectedItems(1)
Set ofol = fso.GetFolder(stPath)
 
For Each oFl In ofol.Files
    
    Selection.InsertFile FileName:=oFl.Name, Range:=""
Next oFl
 
Set ofol = Nothing
Set oFl = Nothing
Set dlg = Nothing
Set fso = Nothing
 
 
End Sub

[aba_tarn]

Bonjour,

Je pense que je vais opter pour l'ajout de mes documents dans un seul.

Lors de la création de mes fichiers, je les enregistre tous dans un même dossier.

je ne comprend pas ce que fait ce code exactement? Comment je lui défini le chemin de mon dossier?

[Heureux-oli]

Salut,

Dans le code que j'ai donné, on ouvre une boîte de dialogue qui va récupérer le chemin du dossier.

Fais un essai !

[aba_tarn]

J'ai fait un essai mais j'ai un soucis sur

Dim dlg As FileDialog

j'ai le message d'erreur suivant :

Type défini par l'utilisateur non défini

pourtant j'ai bien rajouté la référence Microsoft Scripting Runtime

[aba_tarn]

c'est bon, j'ai résolu mon problème, je n'avais pas coché la référence microsoft office object library. Par contre le code ne me crée pas de nouveau fichier... Est-ce normal? Le code est sensé faire quoi exactement? Car c'est la première fois que je vois certaines fonctions du coup je ne comprends pas tout le code.

merci beaucoup!

[Heureux-oli]

Salut,

Le code est censé insérer les fichiers d'un répertoire dans le document courant.

Je viens de faire un nouveau test et tout fonctionne.

[aba_tarn]

Ok, merci je viens de comprendre le fonctionnement, j'ai rajouté des sauts de pages pour que chaque sous document soit sur une nouvelle page. Par contre est-ce que je peux définir un chemin figé? Parce que j'ai essayé de modifier le code, je n'y suis pas arrivée.

Merci

[Heureux-oli]

Salut,

Si tu veux un chemin en dur, c'est dans la variable stPath

[aba_tarn]

c'est ce que j'avais testé:

Sub macro_test()
'
'
' Ajouter la bibliothèque Microsoft Scripting Runtime
'
Dim fso As FileSystemObject
Dim dlg As FileDialog
Dim oFl As File
Dim ofol As Folder
Dim stPath As String
 
 
Set fso = New FileSystemObject
'Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
'dlg.Show
stPath = "C:\Courriers\"
Set ofol = fso.GetFolder(stPath)
 
For Each oFl In ofol.Files
    
    Selection.InsertFile FileName:=oFl.Name, Range:=""
    Selection.InsertBreak (wdPageBreak)
Next oFl
 
Set ofol = Nothing
Set oFl = Nothing
Set dlg = Nothing
Set fso = Nothing
 
 
 
 
'
 
End Sub

Cependant sur la ligne

Selection.InsertFile FileName:=oFl.Name, Range:=""

j'ai l'erreur suivante:

erreur d'execution 91
Variable objet ou variable de bloc with non définie.

Je ne vois pas d'où vient l'erreur...

Et encore merci pour le temps que vous me consacrez, il ne me reste plus que le chemin et j'aurai résolu mon problème!

[Heureux-oli]

Essaie sans le dernier "\"