VBA - Export Excel → Word

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

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

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. 8-)

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:

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 :roll:)
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:

1 2 .PasteSpecial Link:=True, DataType:=wdPasteBitmap, Placement:= _ wdInLine, DisplayAsIcon:=False
Mais c'est tout ce que je sais :D

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

05/08/2019, 10h11
Philippe Tulliez
Bonjour,

Citation:

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:
  
  Objet.Selection.PasteSpecial DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine
Voir discussions sur le même sujet
- Transfert de données Excel vers Word
- Copie de données Excel dans Word et mise en forme
Citation:

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
05/08/2019, 10h33
Anthony47

Bonjour Phillippe,

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

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

Code:

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 ? :mrgreen:

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

05/08/2019, 14h22
Philippe Tulliez

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:

Selection.InsertBreak Type:=wdPageBreak
05/08/2019, 14h35
Anthony47

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)

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:

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

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:

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:

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

05/08/2019, 17h08
Philippe Tulliez
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
- Early ou Late Binding
- VBA : Énumération ou Comment utiliser l'énumération pour rendre votre code plus lisible et plus facile à maintenir
Discussion intéressante sur le sujet
- Enumérer les constantes Office pour les utiliser en LATE BINDING
05/08/2019, 17h18
Anthony47

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

Je n'y comprend rien.. :calim2:

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:

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

06/08/2019, 09h50
Anthony47
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.. :weird:

En l’occurrence, je voulais rajouter ces bouts :
Code:

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/

Bonjour,

Citation:

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

Citation:

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:

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:

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

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

Code:

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:

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 ? :roll:

07/08/2019, 15h25
Philippe Tulliez

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

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

Voici le code actuel :

Code:

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

08/08/2019, 15h05
Philippe Tulliez

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

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 ?
08/08/2019, 15h14
Anthony47

Citation:

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. :?

Citation:

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é ! :mouarf:

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. :mrgreen:
08/08/2019, 15h39
Philippe Tulliez

Bonjour,

Citation:

Je n'arrive pas à faire ça

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

Citation:

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
08/08/2019, 15h56
Anthony47

Citation:

il y a des bouts de codes qui donnent la solution

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

Citation:

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)

Voir 40 message(s) de cette discussion en une page