Export plusieurs extraits d'un EXCEL vers 1 WORD

Version imprimable

2 pièce(s) jointe(s)

Bonjour,
Tous les 3 mois ma boss prépare le compte rendu au CA qui suit toujours la même trame:
On a un tableau de suivi de production commun où on suit tous nos projets avec tout un tas de dates prévisionnelles.

Pour établir ce rapport voici la trame :
- cacher les colonnes inutiles
- copie colle un extrait du tableau en filtrant la phase de projet
- petit commentaire pour les projets concernés par cette phase
- rebelotte pour les phase suivante..
- conclusion générale

Exemple :
Pièce jointe 613541 notre tableau de prod
le rapport
Pièce jointe 613542

(désolée pour les puristes, il s'agit d'un vulgaire exemple vite fait sur google sheets :) )

Exporter un fichier excel dans word, c'est facile mais là je butte étant donné qu'il s'agit de plusieurs extraits avec différents filtres du tableau.
J'ai bien pensé aux affichages personnalisés mais bon reste toujours le fastidieux copié collé.
Je ne maîtrise pas du tout les tableaux croisés dynamiques mais je ne pense pas que cela convienne.
Je suis béotienne en macro et VBA, mais comme j'aime bien les défis, si c'est la méthode à utiliser je vais apprendre :)

J'ai trouvé ce code sur internet, mais cela crée un word par export, ce n'est pas ce que je recherche :) Bon et le graphique, pour l'instant c'est pas la priorité
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 Sub Passage_Excel_Word() Dim appWord As New Word.Application Dim docWord As New Word.Document ' Il faut créer un nouveau document Word dans l'application Word With appWord .Visible = True Set docWord = .Documents.Add .Activate End With 'Dans Word on ajoute une ligne de titre avec une mise en forme With appWord.Selection .TypeText Text:="Chiffre d'affaire 2003" .HomeKey Unit:=wdLine .EndKey Unit:=wdLine, Extend:=wdExtend .ParagraphFormat.Alignment = wdAlignParagraphCenter .Font.Size = 18 With .Font .Name = "Arial" .Size = 16 .Bold = True End With 'Copier le tableau Excel dans le presse papier Range("a1:b8").Copy ' Coller le tableau dans Word avec liaison .EndKey Unit:=wdLine .TypeParagraph .PasteSpecial Link:=True, DataType:=wdPasteOLEObject, _ Placement:=wdInLine, DisplayAsIcon:=False 'Copier le graphique Excel dans le presse papier ActiveSheet.ChartObjects(1).Activate ActiveChart.ChartArea.Select ActiveChart.ChartArea.Copy 'Coller le graphique dans Word .TypeParagraph .Paste End With 'Enregistrer le document Word With docWord .SaveAs ThisWorkbook.Path & "\ca_2003.doc", Allowsubstitutions:=True 'Dans Word Aperçu avant impression du résultat .PrintPreview 'Réinitialiser l'objet Set appWord = Nothing End With End Sub
La source de ce code : https://olivier-bureautique.blogspot...e-passage.html

Merci à tous

1 pièce(s) jointe(s)

Bonjour,

Une façon de faire, à compléter/adapter:

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
Option Explicit
 
'--- demande référence Microsoft Word xx.x Object Library
 
Dim appWord As New Word.Application
Dim docWord As New Word.Document
 
Sub Passage_Excel_Word()
    '--- crée un nouveau document Word dans l'application Word
    With appWord
        .Visible = True
        Set docWord = .Documents.Add
        .Activate
    End With
    ExportBloc "Projet en montage", "1-Montage"
    ExportBloc "Permis déposé", "2-PCD"
    ExportBloc "Permis obtenu", "3-PCO"
    '--- enregistre le document Word
    With docWord
        .SaveAs ThisWorkbook.Path & "\Test.doc", Allowsubstitutions:=True   '--- à adapter
        '.PrintPreview                  '--- aperçu avant impression
    End With
    '--- réinitialise
    Set docWord = Nothing
    Set appWord = Nothing
    ActiveSheet.UsedRange.AutoFilter    '--- supprime le filtrage
End Sub
 
Private Sub ExportBloc(sTitre As String, sPhase As String)
    '--- dans Word on ajoute une ligne de titre avec une mise en forme
    With appWord.Selection
        .TypeText Text:=sTitre
        .HomeKey Unit:=wdLine
        .EndKey Unit:=wdLine, Extend:=wdExtend
        .ParagraphFormat.Alignment = wdAlignParagraphLeft  '--- ou wdAlignParagraphCenter
        With .Font
            .Name = "Arial"
            .Size = 16
            .Bold = True
        End With
        '--- filtre et copie le tableau Excel dans le presse papier
        With ActiveSheet.UsedRange
            .AutoFilter Field:=3, Criteria1:=sPhase     '--- filtre sur 3e champ du tableau
            .SpecialCells(xlCellTypeVisible).Copy       '--- copie les lignes visibles (filtrées)
        End With
        '--- colle le tableau dans Word sans liaison
        .EndKey Unit:=wdLine
        .PasteSpecial Link:=False, DataType:=wdPasteRTF, Placement:=wdInLine, DisplayAsIcon:=False
        '--- ajuste la taille des colonnes
        With docWord.Tables(docWord.Tables.Count)
            .Columns(1).SetWidth ColumnWidth:=80, RulerStyle:=wdAdjustNone
            .Columns(2).SetWidth ColumnWidth:=80, RulerStyle:=wdAdjustNone
            .Columns(3).SetWidth ColumnWidth:=80, RulerStyle:=wdAdjustNone
            .Columns(4).SetWidth ColumnWidth:=60, RulerStyle:=wdAdjustNone
        End With
        .TypeParagraph
        .TypeParagraph
    End With
End Sub

Cordialement.

2 pièce(s) jointe(s)

Hello,
en reprenant le code à Eric, voici quelques améliorations :
1 - Masquage des colonnes inutiles
2 - Utilisation d'un tableau pour régler les largeurs des colonnes des tableaux de sortie.

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
Option Explicit
 
'--- demande référence Microsoft Word xx.x Object Library
 
 
Dim appWord As New Word.Application
Dim docWord As New Word.Document
 
 
Sub Passage_Excel_Word()
    '--- crée un nouveau document Word dans l'application Word
    With appWord
        .Visible = True
        Set docWord = .Documents.Add
        .Activate
    End With
    Range("B:B,C:C").EntireColumn.Hidden = True '-- masque les colonnes B et C
    ExportBloc "Projets en montage", "1-Montage"
    ExportBloc "Permis déposés", "2-PCD"
    ExportBloc "Permis obtenus", "3-PCO"
    ExportBloc "Chantiers démarrés", "4-chantier"
    '--- enregistre le document Word
    With docWord
        .SaveAs ThisWorkbook.Path & "\Test.doc", Allowsubstitutions:=True   '--- à adapter
        '.PrintPreview                  '--- aperçu avant impression
    End With
    '--- réinitialise
    Set docWord = Nothing
    Set appWord = Nothing
    ActiveSheet.UsedRange.AutoFilter    '--- supprime le filtrage
    Range("B:B", "C:C").EntireColumn.Hidden = False '-- affiche les colonnes masquées
End Sub
 
 
Private Sub ExportBloc(sTitre As String, sPhase As String)
    '--- dans Word on ajoute une ligne de titre avec une mise en forme
    With appWord.Selection
        .TypeText Text:=sTitre
        .HomeKey Unit:=wdLine
        .EndKey Unit:=wdLine, Extend:=wdExtend
        .ParagraphFormat.Alignment = wdAlignParagraphLeft  '--- ou wdAlignParagraphCenter
        With .Font
            .Name = "Arial"
            .Size = 16
            .Bold = True
        End With
        '--- filtre et copie le tableau Excel dans le presse papier
        With ActiveSheet.UsedRange
            .AutoFilter Field:=4, Criteria1:=sPhase     '--- filtre sur 4e champ du tableau
            .SpecialCells(xlCellTypeVisible).Copy       '--- copie les lignes visibles (filtrées)
        End With
        '--- colle le tableau dans Word sans liaison
        .EndKey Unit:=wdLine
        .PasteSpecial Link:=False, DataType:=wdPasteRTF, Placement:=wdInLine, DisplayAsIcon:=False
        '--- ajuste la taille des colonnes
        Dim w()
        Dim col
        Dim i As Integer
        i = 0
        'tableau des largeurs de colonnes de sortie
        w() = Array(175, 55, 30, 45, 45, 45, 45, 48)
        With docWord.Tables(docWord.Tables.Count)
             For Each col In .Columns
               col.SetWidth ColumnWidth:=w(i), RulerStyle:=wdAdjustNone
               i = i + 1
             Next
        End With
        .TypeParagraph
        .TypeParagraph
    End With
End Sub

Résultat document Word :
Pièce jointe 613590

Classeur en pièce jointe.

Ami calmant, J.P