VBA - Export Excel → Word

**Anthony47** · 05/08/2019, 09h51

Bonjour à tous,

Pour plus de lisibilité, je créé ce topic avec les mises à jour qui s'imposent.

J'ai un fichier excel, d'une dizaine d'onglets, qui me sort au final 3 onglets utiles, synthétiques, mis en forme et qu'il faut que j'exporte sur Word.

J'ai regardé l'export avec liaison d'Excel sous Word et j'ai trouvé deux modes de collages plutôt pratiques : Avec liaison - Feuille de calcul Excel ou Avec liaison - Image en mode point.

En tout cas si j'utilise un des deux, que je réduis par les coins le tout pour que ça rentre en largeur ma feuille A4, ça donne quelque chose de plutôt correct et qui se modifie selon ce que je tape sur Excel.

j'ai trouvé sur le net comment faire pour générer les plages nommées comme mes sauts de page (ce qui me permet d'avoir une plage nommé par page Word):

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
Sub test()
    suppNomsPage "En_tête"
    nommerPages "En_tête"
     suppNomsPage "Descriptif"
    nommerPages "Descriptif"
     suppNomsPage "Carac_tech"
    nommerPages "Carac_tech"
End Sub
 
Sub nommerPages(nomF As String)
    Dim HPB As HPageBreak, numP As Long, nom As String
    Dim pl As Range, lig As Long, col1 As Long, nbCol As Long, derlig As Long
    ActiveWindow.View = xlPageBreakPreview
    With Sheets(nomF)
        On Error GoTo fin
        Set pl = Range(.PageSetup.PrintArea)
        On Error GoTo 0
        col1 = pl.Column: nbCol = pl.Columns.Count: derlig = pl.Row + pl.Rows.Count - 1
        lig = pl.Row
        For Each HPB In .HPageBreaks
            numP = numP + 1
            Set pl = .Cells(lig, col1).Resize(HPB.Location.Row - lig, nbCol)
            nom = nomF & "!page_" & Format(numP, "00")
            pl.Name = nom
            lig = HPB.Location.Row
        Next HPB
        If lig < derlig Then
            numP = numP + 1
            Set pl = .Cells(lig, col1).Resize(derlig - lig + 1, nbCol)
            nom = nomF & "!page_" & Format(numP, "00")
            pl.Name = nom
        End If
    End With
End Sub
 
Sub suppNomsPage(nomF As String)
    Dim nom As Name
    For Each nom In ActiveWorkbook.Names
        If Left(nom.Name, Len(nomF) + 6) = nomF & "!page_" Then nom.Delete
    Next nom
End Sub

Donc maintenant il ne manque plus qu'à faire une extraction de ces plages nommées sur Word.

Pour ça je verrais bien un code du style
Ouvrir Word,
copier page 1 de la feuille En_tête,
coller sur Word en tant qu'image mode point, (largeur collage = large page Word, serait la cerise sur le gâteau

)
si page_02 de en_tête existe, alors copier/coller image mode point à la page 2 du word
puis checker si page_03 existe etc,

sinon passer à l'onglet suivant,
copier page_01 de l'onglet Descriptif, puis coller sur Word à la page suivante
checker si page_02 de descriptif existe, etc

puis passer au dernier onglet Carac_tech
Et idem page_01 copier/coller sur word à la page suivant etc.

Sinon on peut aussi copier/coller sur word puis insérer un saut de page sur word, comme ça on est à la suivante

Si ça peut aider, le collage se fait comme ça

Code :

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

1
2
.PasteSpecial Link:=True, DataType:=wdPasteBitmap, Placement:= _
        wdInLine, DisplayAsIcon:=False

Mais c'est tout ce que je sais

Voilà, merci à tous, hésitez pas si je peux éclaircir quelques points

**Philippe Tulliez** · 05/08/2019, 10h11

Bonjour,

Donc maintenant il ne manque plus qu'à faire une extraction de ces plages nommées sur Word.

Personnellement pour transférer des données d'excel vers word, j'utilise un document Word qui sert de modèle et qui contient des signets (Objet Bookmark de la collection Bookmarks)
Une fois ce "modèle" ouvert je transfère les données d'excel vers word en utilisant deux méthodes différentes suivant qu'il s'agisse de valeur contenue dans une cellule ou dans une plage de cellules. Les cellules nommées dans excel portant le même nom que les signets dans Word

Une cellule - j'utilise la propriété Text de l'objet Range (cellule nommée) pour la placer dans le signet
Une plage de cellules - j'utilise le Copier/Collage-Spécial Image (méta fichier amélioré) manuellement on conserve le format des cellules (couleur, police) d'excel. Soit en VBA
Code : Sélectionner tout - Visualiser dans une fenêtre à part
```
Objet.Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
```

Voir discussions sur le même sujet

sinon passer à l'onglet suivant,
copier page_01 de l'onglet Descriptif, puis coller sur Word à la page suivante
checker si page_02 de descriptif existe, etc

C'est également possible

Je te conseille la lecture de ce tutoriel Débutez en VBA Word

**Anthony47** · 05/08/2019, 10h33

Bonjour Phillippe,

Merci pour tes liens je vais regarder tout ça. En tout cas ça me confirme que c'est possible !

**Anthony47** · 05/08/2019, 14h12

Alors.. en reprenant le code de Zekraoui_Jakani, j'arrive à faire un petit quelque chose..

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
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 
ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
            End With
 
ThisWorkbook.Worksheets("En_tête").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
            End With
 
 
ThisWorkbook.Worksheets("Descriptif").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
            End With
 
 
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
 
End Sub

Que pensez-vous de mon petit bout de code ?

La ou je bloque :
- J'arrive pas à ajouter un saut de page (ou à faire un coller sur la page suivante) : InsertBreak Type:=wdPageBreak ne fonctionne pas.

- Je ne parviens pas à mettre les conditions, si ThisWorkbook.Worksheets("En_tête").Range("page_02") n'existe pas, alors passer à la suite.

- Je n'ai pas trouvé comment régler les marges du Word (ou les supprimer)

- Je ne sais pas comment réduire la dimensions de mes collages

**Philippe Tulliez** · 05/08/2019, 14h22

Bonjour,
Même s'il n'est pas aussi performant que celui d'excel, Word possède également son enregistreur de macros et cet outil a un mérite c'est nous donner les méthodes et propriétés des objets que l'on doit manipuler.
Malgré mes années d'expérience en développement VBA, il m'arrive régulièrement de l'utiliser pour l'emploi d'objet que je manipule rarement ou pour la première fois.
Le forum Word même s'il n'est pas aussi actif que celui-ci est également intéressant à consulter et la page Word de ce site est riche de tutoriels sur le VBA Word pour la plupart écrit par Olivier Lebeau.
Voici la ligne de code du saut de page en Word que vient de me donner l'enregistreur de macros Word

Code :

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

Selection.InsertBreak Type:=wdPageBreak

**Anthony47** · 05/08/2019, 14h35

C'est gràce à l'enregistreur de macro que j'avais obtenu le même code que vous pour le saut de page, mais il ne fonctionne pas (propriété ou méthode non gérée par cet objet)

J'irai sur le forum Word pour les questions de mise en forme.

Savez-vous comment régler les conditions d’existence des plages nommées ? (pour l'onglet descriptif, ça peut aller jusqu'à 15 plages)

**Philippe Tulliez** · 05/08/2019, 15h06

Bonjour,
Voici un bout de code très simple que j'utilise pour mes formations VBA. Code à placer dans un module standard VBA Excel
Le code utilise le Late Binding donc le référencement à la bibliothèque Word ne doit pas être fait et j'utilise donc la valeur 7 pour wdPageBreak qui ne peut être reconnu

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
Sub WordWrite()
 Dim objWord As Object
 Set objWord = CreateObject("Word.Application.8")
 objWord.Visible = True ' Affiche Word
 objWord.Documents.Add 'Ajoute un document
 
 With objWord.Selection
 .TypeParagraph
 .TypeText Text:="Procédure pour écrire dans Word "
 .TypeParagraph
 .TypeText Text:="Philippe :o)"
 .InsertBreak Type:=7 ' Saut de page (7 = constante wdPageBreak)
 ' .TypeParagraph
 End With
 ' pour imprimer le document
 ' objWord.PrintOut
 Set objWord = Nothing
End Sub

**Anthony47** · 05/08/2019, 16h51

Ah merci, le saut de page fonctionne bien de cette façon !

Pour revoir la mise en forme, l’enregistreur de macro Word me proposait

Code :

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

1
2
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 498.9

Mais je ne parvient pas à l'insérer correctement dans mon code, j'ai une erreur de "propriété ou méthode non gérée par cet objet"

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
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 ' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
 ' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
 
 
ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
 
               .TypeParagraph
                .InsertBreak Type:=7
            End With
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 498.9
 
ThisWorkbook.Worksheets("En_tête").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
 
 
ThisWorkbook.Worksheets("Descriptif").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
 
 
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
 
End Sub

Vous auriez une idée pour gérer les conditions d’existence des plages nommées ? IF ThisWorkbook.Worksheets("Descriptif").Range("page_01").exist

**Philippe Tulliez** · 05/08/2019, 17h08

Bonjour,
Si le saut de page fonctionne maintenant en utilisant l'exemple que j'ai publié, c'est que tu utilises sans doute également le Late Binding et donc toutes les constantes Word (préfixées wd ne sont pas reconnues et donc il faut soit créer des constantes énumérées (voir ci-dessous) soit utiliser leur valeur (pour connaître la valeur d'une constante Word, il faut soit référencer la bibliothèque Word dans excel soit aller dans Word) et dans les deux cas dans l'éditeur faire un Debug.Print (ou MsgBox) suivi du nom de la constante

A lire les tutoriels sur le sujet

Discussion intéressante sur le sujet

Enumérer les constantes Office pour les utiliser en LATE BINDING

**Anthony47** · 05/08/2019, 17h18

Olala.. c'est tellement un autre niveau..

Je n'y comprend rien..

**Philippe Tulliez** · 05/08/2019, 18h53

Bonjour,
Lorsque l'on développe en VBA, il y a des bibliothèques référencées par défaut (au nombre de cinq pour Excel)
Si l'on souhaite travailler également avec Word, Outlook, PowerPoint, etc. nous sommes obligés d'ajouter des bibliothèques ainsi pour Word c'est Microsoft word xx.x 0bject Library ou xx représente le n° de version de Word
Tout va bien si l'on utilise l'application pour soi mais dès que l'on doit distribuer l'application pour des collègues ou des clients les problèmes peuvent commencer à surgir. Ainsi si une personne à une version antérieure à celle référencée il y aura un message pour référence manquante. C'est ainsi que si l'on veut limiter les problèmes on livre des applications en Late Binding et ainsi l'application tourne sur toutes les versions et la maintenance en est simplifiée.
Pour une explication plus détaillée, je renvoie aux liens que j'ai référencé dans ma précédente intervention.

Voici un code simple qui copie dans un nouveau document Word les plages A1:G8 et A11:E14 de la feuille nommée [Data] du classeur Excel où se trouve le code VBA. Il y a un titre avant chaque tableau et un saut de page entre le premier et le second tableau
Il faut bien entendu une feuille nommée [Data] dans le classeur avec deux plages A1:G8 et A11:E14 contenant chacune un tableau

Il faut donc référencer la bibliothèque Word avant de lancer la procédure (Outils/Références..) et dans la boîte de dialogue Références - VBA Project chercher la référence à Microsoft word xx.x 0bject Library

Code de la procédure à placer dans un module standard

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
Sub ExporterDonneesExcelVersWord()
 ' *** Nécessite d'activer la reference Microsoft word xx.x 0bject Library ***
 '
 ' Formation VBA pour Excel
 '   Interface avec application Word
 ' MagicOffice www.magicoffice.be
 ' Déclaration
 Const IsNewDocument As Boolean = True ' True pour nouveau document / False pour ouvrir Tableau.doc
 Const SubFolder = "\data\"
 Dim Folder As String
 Dim FullName As String
 Dim shtSource As Worksheet   ' Feuille source où se trouve les tableaux
 Dim oWrd As Word.Application ' Application Word
 Dim DocWord As Word.Document ' Document Word où seront collés les tableaux
 ' Affectation
 Set oWrd = New Word.Application
 Set shtSource = ThisWorkbook.Worksheets("Data")
 Folder = ThisWorkbook.Path
 FullName = Folder & SubFolder & "TABLEAU.doc"
 '
 Application.DisplayAlerts = True
 oWrd.Visible = True  ' Affiche Word
 ' Ouvre le document Word
 If IsNewDocument Then
    Set DocWord = oWrd.Documents.Add 'Ajoute un document
  Else
    Set DocWord = oWrd.Documents.Open(FullName, ReadOnly:=False)
 End If
 ' Copie / Colle les données dans Word
 With oWrd.Selection
 .TypeText Text:="TABLEAU 1"      ' Ecrit un texte
 .TypeParagraph                   ' Saut de paragraphe
  shtSource.Range("A1:G8").Copy   ' Copie du premier tableau
 .PasteSpecial                    ' Colle le tableau
 .InsertBreak Type:=wdPageBreak   ' Saut de page
 .TypeText Text:="TABLEAU 2"      ' Ecrit un texte
 .TypeParagraph                   ' Saut de paragraphe
  shtSource.Range("A11:E14").Copy ' Copie du premier tableau
 .PasteSpecial                    ' Colle le tableau
 End With
 With DocWord
  Application.CutCopyMode = False
 ' Pour sauver le document enlever l'apostrophe de la ligne du dessous
 ' .Application.ActiveDocument.SaveAs "monTableau"
 End With
 If MsgBox("Voulez-vous fermer l'application", vbYesNo) = vbYes Then
    oWrd.Application.Quit
 End If
 Set shtSource = Nothing: Set oWrd = Nothing: Set DocWord = Nothing
End Sub

**Anthony47** · 06/08/2019, 09h50

Bonjour Philippe,

Merci, c'est un poil plus clair. Je comprend mieux les termes (énumération, bibliothèque, late/early binding), et je vois un peu comment les retrouver dans un code.

Mais de là à rajouter ça dans mon code..

En l’occurrence, je voulais rajouter ces bouts :

Code :

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

1
2
3
4
5
 
PageSetup.LeftMargin = CentimetersToPoints(1)
PageSetup.RightMargin = CentimetersToPoints(1)
Selection.InlineShapes(1).LockAspectRatio = msoTrue
Selection.InlineShapes(1).Width = 498.9

Mais il n'y a pas de fonction qui commence en wd là (en revanche elles sont issues de Word).

Après je poserai la question sur le forum Word si vous voulez !

La j'ai d'abord besoin d'aide pour gérer les conditions d’existence des plages nommées ? IF thisWorkbook.Worksheets("Descriptif").Range("page_01").existj'ai trouvé une solution sur le forum mais comme mes plages ont le même nom (mais ne sont pas dans le même onglet), la solution ne fonctionne pas. Il faudrait que je puisse préciser que c'est la plage "page_01" de tel onglet.

https://www.developpez.net/forums/d1...-plage-existe/

**Philippe Tulliez** · 06/08/2019, 11h13

Bonjour,

Mais il n'y a pas de fonction qui commence en wd là (en revanche elles sont issues de Word).

Il ne s'agit pas de fonction mais de constante

La j'ai d'abord besoin d'aide pour gérer les conditions d’existence des plages nommées ? IF thisWorkbook.Worksheets("Descriptif").Range("page_01").existj'ai trouvé une solution sur le forum mais comme mes plages ont le même nom (mais ne sont pas dans le même onglet), la solution ne fonctionne pas. Il faudrait que je puisse préciser que c'est la plage "page_01" de tel onglet.

Sauf erreur de ma part, il n'y a pas de propriété Exist pour vérifier l'existence d'une plage nommée alors que cette propriété est présente pour l'objet BookMark
Par contre il est possible de créer sa propre fonction pour en vérifier l'existence

Si tu dis que les plages ont le même nom mais sont présentes dans plusieurs feuilles, il s'agit donc de cellules nommées de portabilité Feuille

Voici une fonction nommée IsNameExist qui vérifie l'existence d'une cellule ou plage nommée dans une feuille (si le nom est de portabilité classeur, la fonction renverra False)

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
Function IsNameExist(oSheet As Worksheet, NameOfRange As String) As Boolean
  ' Vérifie l'existence de cellule/plage nommée dans une feuille et renvoie True si trouvé
  ' Philippe Tulliez www.magicoffice.be
  ' Arguments
  '   oSheet      ' Objet Feuille
  '   NameOfRange ' Nom à chercher
  ' Declaration
  Dim NameTemp As String
  Dim Counter As Integer
  '
  With oSheet
    If .Names.Count Then
       Counter = 1
       While Counter <= .Names.Count
         NameTemp = .Names(Counter).Name
         NameTemp = Mid(NameTemp, InStrRev(NameTemp, "!") + 1)
         If NameOfRange = NameTemp Then
            IsNameExist = True: Counter = oSheet.Names.Count
         End If
         Counter = Counter + 1
        Wend
    End If
  End With
End Function

Exemple d'une procédure qui l'invoque

Code :

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

1
2
3
4
5
6
Sub TestIsNameExist()
  Const sName As String = "PagePrevious"
  Dim sht As Worksheet
  Set sht = ThisWorkbook.Worksheets("CA 19")
  MsgBox sName & " - " & IIf(IsNameExist(sht, sName), "existe", "n'existe pas") & " dans la feuille " & sht.Name
End Sub

**Anthony47** · 07/08/2019, 09h56

Bonjour Philippe, sur le net j'avais trouvé un autre bout de code

Code :

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

1
2
3
4
5
6
7
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function

Comme il est sensiblement différent du votre je me demandais si ça vous paraissait bon ?

Je l'ai intégré à mon code et ça fonctionne, mais mon code est long.. et je l'ai pas fait en entier puisque sur un de mes onglets le nombre de plages va de 1 à 15 et s'il y a pas de page_03, il n'y aura pas de page_04 ou plus.
Bref le nombre le plus élevé détermine le nombre de plage nommées qu'il y aura sur cet onglet

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
 ' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
 ' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
 
ThisWorkbook.Worksheets("En_tête").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
 
               .TypeParagraph
                .InsertBreak Type:=7
            End With
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9
 
If exist("en_tête", "page_02") Then
ThisWorkbook.Worksheets("En_tête").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
 
If exist("en_tête", "page_03") Then
ThisWorkbook.Worksheets("En_tête").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
 
ThisWorkbook.Worksheets("Descriptif").Range("page_01").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
 
If exist("Descriptif", "page_02") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_02").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
 
If exist("Descriptif", "page_03") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_03").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_04") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_04").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_05") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_05").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_06") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_06").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
If exist("Descriptif", "page_07") Then
ThisWorkbook.Worksheets("Descriptif").Range("page_07").Copy
  With obj.Selection
                .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
                    Placement:=wdInLine, DisplayAsIcon:=False
                .TypeParagraph
                .InsertBreak Type:=7
            End With
End If
 
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
 
End Sub

Vous voyez comment le simplifier ?

**Philippe Tulliez** · 07/08/2019, 15h25

Bonjour,
La procédure nommée Exist a première lecture semble aprfaitement correcte. Elle est basée sur la détection d'une erreur alors que dans celle que j'ai proposée j'exécute une boucle.
C'est une autre manière d'aborder le sujet.
C'est la même chose pour vérifier si une feuille existe. Soit on parcoure sa collection, soit on intercepte l'erreur. C'est cette option que j'ai prise pour ce cas là Fonction testant l’existence d’une feuille dans un classeur

**Anthony47** · 08/08/2019, 14h00

Je met à jour aussi ce topic, même s'il est dans la rubrique Excel, ça peut servir

Voici le code actuel :

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
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function
 
Sub export_excel_to_word()
 
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
    Dim MonInlineShape As Object 'Nouveau
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
 
' newObj.PageSetup.LeftMargin = CentimetersToPoints(1)
' newObj.PageSetup.RightMargin = CentimetersToPoints(1)
 
For n = 1 To 3
    If exist("En_tête", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("En_tête").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
Set MonInlineShape = newObj.inlineshapes(1) 'nouveau
    With MonInlineShape
         .LockAspectRatio = msoTrue
         .Width = 460.8
    End With
 
'Selection.InlineShapes(1).LockAspectRatio = msoTrue
'Selection.InlineShapes(1).Width = 498.9
    End If
Next
 
For n = 1 To 15
    If exist("Descriptif", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Descriptif").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
       ' .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile,
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
For n = 1 To 5
    If exist("Carac_tech", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Carac_tech").Range("page_" & Format(n, "00")).Copy
        With obj.Selection
        .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
        .TypeParagraph
        .InsertBreak Type:=7
        End With
    End If
Next
 
   Application.CutCopyMode = False
 
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
 
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate    'vous pouvez jouer sur les marges pour améliorer la lecture
    Set obj = Nothing
    Set newObj = Nothing
    Set MonInlineShape = Nothing
 
End Sub

J'ai les bons objets qui se collent au bon endroit, mais ils n'ont pas le bon format. (trop grand, il faut garder la proportion et diminuer la largeur)

Si vous le souhaitez vous pouvez retrouver mon fichier test ici https://www.cjoint.com/c/IHil4RJmvQP

**Philippe Tulliez** · 08/08/2019, 15h05

Bonjour,
Personnellement, je n'ai aucun problème de format lors de mon transfert des données d'Excel vers word mais je n'utilise pas les mêmes arguments pour le PasteSpecial
Relire ce que j'ai écris dans le #Fil 2

Je m'interroge également sur la raison qui te pousse à copier la page entière d'Excel. Y a t'il un impératif ?
Ne serait-ce pas plus "propre" de créer le texte fixe dans un modèle Word et ne copier que les parties variables ?

**Anthony47** · 08/08/2019, 15h14

Personnellement, je n'ai aucun problème de format lors de mon transfert des données d'Excel vers word mais je n'utilise pas les mêmes arguments pour le PasteSpecial

Je n'arrive pas à faire ça

Moi je veux bien faire un modèle initial avec des signets des marges, des entêtes et pieds de page qui vont bien. C'est juste que je ne sais pas comment le faire, ni comment reprendre ça sur mon VBA.

Je m'interroge également sur la raison qui te pousse à copier la page entière d'Excel. Y a t'il un impératif ?
Ne serait-ce pas plus "propre" de créer le texte fixe dans un modèle Word et ne copier que les parties variables ?

C'était ma première idée, mais j'ai vite déchanté !

Le résultat final inscrit dans mes 3 onglets est issu d'un long processus de calcul et de choix de l'utilisateur sur d'autres onglets.

En fait tout est variable, l'utilisateur peut modifier toutes les données, les valeurs, les appellations, la mise en forme, le nombre de lignes.

La seule chose qui ne bougera pas c'est le nombre de colonnes exportées.

**Philippe Tulliez** · 08/08/2019, 15h39

Bonjour,

Je n'arrive pas à faire ça

Pourtant dans les deux liens du #Fil 2, il y a des bouts de codes qui donnent la solution.

Moi je veux bien faire un modèle initial avec des signets des marges, des entêtes et pieds de page qui vont bien. C'est juste que je ne sais pas comment le faire, ni comment reprendre ça sur mon VBA

Cela vaut la peine d'investir du temps pour cette solution car elle est bien plus simple à mettre en place que de commencer à corriger les formats, les hauteurs de pages, marges, etc.

Bien relire le contenu des pages référencées

**Anthony47** · 08/08/2019, 15h56

il y a des bouts de codes qui donnent la solution

S'il y a la solution, je ne la vois pas

Cela vaut la peine d'investir du temps pour cette solution car elle est bien plus simple à mettre en place que de commencer à corriger les formats, les hauteurs de pages, marges, etc.

Je suis bien d'accord !

J'ai lu tous les éléments que tu me joins à chaque fois, parfois je comprend un peu de qoi il s'agit, mais de là à créer le code c'est une autre paire de manche. ^^'

1-Comment on fait un fichier Word modèle ?
2-Comment on ajoute un signet et comment j'y fais référence dans ma boucle for ?
3-Quand je fais le copier/coller manuel en image métafichier c'est bon sans le collage avec liaison mais c'est pas bon si j'ai le collage avec liaison
(d'ailleur je vois que sans liaison il s'appelle Image (métafichier améliroé) alors qu'avec liaison il s'appelle Image (métafichier Windows)

VBA - Export Excel → Word

Macros et VBA Excel

Discussions similaires

Partager

Partager