Discussion :

[Anthony47]

Bonjour à tous !

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

Pour diverses raison j'ai besoin d'exporter avec liaisons ces onglets sur un fichier Word.
Et à partir de là, il y a peut-être beaucoup plus efficace à faire, ça je ne sais pas

En tout cas j'ai trouvé deux modes de collages sur Word 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.

Le problème (on y vient) c'est que ce que j'ai à mettre sur mon word prend parfois plusieurs pages et parfois non. (ça varie en fonction des lignes masquées ou non)
Je vois que la liaison est maintenue par une zone d'impression, si je modifie la plage de cette zone sur Excel, ça se modifie bien sur Word aussi.
Du coup je me dis qu'il faudrait que la zone d'impression fasse tout pile une page A4, ou fasse un maximum de 25 lignes par exemple)

D'ailleurs, en lisant d'autres post, j'ai l'impression que c'est faisable avec du VBA, mais je suis incapable de le faire

En gros j'ai 3 onglets :

- En_tête Le premier fait 1 à 2 pages
- Descriptif Le deuxième fait de 1 à 15 pages, facilement identifiables (l'utilisateur va faire en sorte que chaque page se termine au même endroit (par exemple chaque ligne 70 fait une nouvelle page : 70, 140, 210, etc)
- Caract_tech Le troisième onglet comme le premier fait de une à deux pages

Si ça peut vous aider, quand je passe par l'enregistreur de macro sous Word et que je fais le coller image en mode point j'obtiens ça

Code :

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

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

Ce serait top d'avoir la génération du fichier Word avec une macro

Merci à tous !

[Anthony47]

Juste pour mettre à jour, grace à l'aide du forum j'ai pu un peu avancer, 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

[Anthony47]

Problème résolu en modifiant manuellement sur Excel les largeurs des colonnes à exporter