Discussion :

[clemtitine]

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 :
notre tableau de prod
le rapport


(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 VBA :

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
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

[EricDgn]

Bonjour,

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

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

[jurassic pork]

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 :

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


Classeur en pièce jointe.

Ami calmant, J.P