Bonjour,

Je dois exporter des données d'un fichier Excel (existant) vers un autre fichier Word (existant également) en gardant la mise en page. Une cellule doit être copiée sur une seule page. Ainsi, si j'exporte 10 lignes du fichier Excel, j'aurai 10 pages dans le fichier Word.
Après des recherches, j'ai opté pour la méthode des signets.

Mon fichier Woord contient 11 champs et j'ai placé les signets devant chaque ligne ou je veux écrire les données contenues dans le fichier Excel.

Seulement, je ne sais le faire que pour une seule ligne du fichier Excel et pas pour les 3015 autres lignes en gardant le même mise en forme.

Ce que je voudrais donc faire:
1. Quand j'ouvre le fichier Word, copier tous les éléments présents (mise en forme, taille de police, etc.)

2.Créer autant de pages dans le fichier Word que de cellules dans le fichier Excel en conservant la mise en page, les éléments, les signets de la première page (qui est mon modèle)

3. Commencer l'exportation en changeant de page après chaque extraction

Je ne sais pas faire tout cela et je suis coincé.

Je vous présente mon code:

Dans un module, j'ai crée:

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
 
Public Function Selection_Fichier(extension As String) As String
    Dim x As Long
 
    With Application.FileDialog(msoFileDialogFilePicker)
        'Autorise la multi-sélection
        .AllowMultiSelect = False
 
        'Définit un nom de fichier par défaut
        '.InitialFileName = "Nom document.doc"
 
        'Efface les filtres existants.
        .Filters.Clear
        'Définit une liste de filtres pour le champ "Type de fichiers".
        If extension = "xls" Then
        'Définit un titre pour la boîte de dialogue
        .Title = "Sélection du fichier Excel"
        .Filters.Add "Fichiers Microsoft Office Excel", "*.xls; *.xlsx; *.xlsm"
        Else
            If extension = "doc" Then
            'Définit un titre pour la boîte de dialogue
            .Title = "Sélection du fichier Word"
            .Filters.Add "Fichiers Microsoft Office Word", "*.doc; *.docx; *.docm", 1
            End If
        End If
 
        'Indique le type d'affichage dans la boîte de dialogue (exemple visualisation des propriétés)
        .InitialView = msoFileDialogViewProperties
        'Affiche la boîte de dialogue
        .Show
 
        'Boucle sur les fichiers sélectionnés
        For x = 1 To .SelectedItems.Count
            Selection_Fichier = .SelectedItems(x)
        Next x
 
    End With
 
End Function
Ensuite, j'ai le code suivant que j'exécute:

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
 
Public Sub ImporterVersWord()
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim ExcelApp As Excel.Application
    Dim ExcelDoc As Excel.Workbook
    Dim fichierexcel As String
    Dim fichierword As String
    Dim lignes As Long
 
    fichierexcel = Selection_Fichier("xls")
    fichierword = Selection_Fichier("doc")
 
    Set WordApp = CreateObject("word.application")    'ouvre une session Word
    Set WordDoc = WordApp.Documents.Open(fichierword)    'ouvre le document Word
 
    Set ExcelApp = CreateObject("excel.application")    'ouvre une session Word
    Set ExcelDoc = ExcelApp.Workbooks.Open(fichierexcel)    'ouvre le document Word
 
    WordApp.Visible = False
    ExcelApp.Visible = False
 
    For i = 2 To 2 'lignes
        For j = 1 To 11
            'les signets du document Word sont nommés Signet1 , Signet2 , Signet3
            WordDoc.Bookmarks("Signet" & j).Range.Text = ExcelApp.Workbooks(1).Sheets(1).Cells(i, j)
        Next j
    Next i
 
    'WordApp.Visible = True    'affiche le document Word
    'WordDoc.PrintOut 'Pour imprimer le doc obtenu
 
    'WordDoc.Close True 'ferme le document word en sauvegardant les données
    'WordApp.Quit 'ferme la session Word
 
    WordApp.Visible = True
    MsgBox ExcelApp.Workbooks(1).Sheets(1).Range("A1").SpecialCells(xlCellTypeLastCell).Row
 
 
    WordDoc.Close
    ExcelDoc.Close
    Set WordApp = Nothing
    Set ExcelApp = Nothing
 
End Sub
J'espère avoir été assez précis.

Merci d'avance pour votre aide