Bonjour ,

A partir d'un classeur excel je lance une macro créant un document word à partir d'un modèle ".dot"

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
Sub CréerCompteRendu()
    Dim objWord As Word.Application
    Dim Docu    As Word.Document
    Dim NomFichier As String
    Dim CodeAgence As String
    Dim CodeSecteur As String
    Dim Secteur As String
    Dim NomAgence As String
    Dim ChefAgence As String
    Dim j As Integer
 
 CheminRacine = Workbooks("Outil_CDG.xls").Sheets("Paramétrage").Range("CheminRacine").Value
 CheminModèles = Workbooks("Outil_CDG.xls").Sheets("Paramétrage").Range("CheminModèles").Value
 
 
'Blocage du recalcul automatique:
'Application.Calculation = xlCalculationManual
 
   On Error GoTo CréerCompteRendu_Error
    If Range("Choix_CodeAgence").Value = "" Then
        MsgBox _
            "Vous n'avez pas préciser pour quelle agence vous souhaitez travailler!", _
            vbExclamation, "Agence non spécifiée"
        Range("Choix_CodeAgence").Select
        Exit Sub
    End If
 
    'Définition des valeurs des variables
    NomFichier = Range("Choix_CodeAgence").Value & "_CRV_" & Left(Replace(Date, "/", ""), 4) _
        & Right(Year(Now), 2)
    CodeAgence = Range("Choix_CodeAgence").Value
    NomAgence = Range("Choix_NomAgence").Value
    CodeSecteur = Sheets("Menu").Range("Agence_CodeSecteur").Value
    Secteur = Sheets("Menu").Range("Agence_CodeSecteur").Value & "_" & Sheets("Menu").Range("Agence_NomSecteur").Value
 
    Sheets("Paramétrage").Select
 
    ChefAgence = ""
    'On va chercher le nomdu chef d'agence
    For j = 1 To Range("Destinataires").Rows.Count - 1
        If Range("Destinataires").Cells(j, 5).Value = CodeAgence Then
            If Range("Destinataires").Cells(j, 3).Value = "CDA" Or _
                Range("Destinataires").Cells(j, 3).Value = "CDD" Then
                ChefAgence = Range("Destinataires").Cells(j, 1).Value & " " & _
                    Range("Destinataires").Cells(j, 2).Value
            End If
        End If
    Next j
    Sheets("Menu").Select
 
    ' création de l'objet Word
    Set objWord = New Word.Application
 
    ' Word visible
    objWord.Visible = True
    objWord.WindowState = wdWindowStateMaximize
    'ouverture du fichier
    Set Docu = _
        objWord.Documents.Add(CheminModèles & "000_CRV_ddmmyy.dot")
With Docu.Sections(1)
.Headers(wdHeaderFooterPrimary).Range.Text = "Visite du " & Date
.Headers(wdHeaderFooterPrimary).Range.Paragraphs.Alignment = wdAlignParagraphCenter
'.Footers(wdHeaderFooterPrimary).PageNumbers.Add
End With
 
    ' Insertion de la date
    objWord.ActiveDocument.Bookmarks("DateVisite2").Range.Text = Date
    ' Insertion du nom de l'agence
    objWord.ActiveDocument.Bookmarks("NomAgence").Range.Text = NomAgence
    ' Insertion du nom du chef d'agence
    objWord.ActiveDocument.Bookmarks("NomChefAgence").Range.Text = ChefAgence
 
'Lancement de la macro insérant les graphiques
    objWord.Run "InséreUnGrapheExcelDansWord"
    objWord.Run "InséreUnTableauExcelDansWord"
 
    ' sauvegarde
            Docu.SaveAs _
                FileName:=CheminRacine _
                & CodeAgence & "_" & NomAgence & "\" & Year(Now) & "\" & _
                "Compte_rendu_de_visite" & "\" & NomFichier & ".doc"
 
    ' fermeture du document
    'Docu.Close
    ' quitter Word
    'objWord.Quit
 
    ' libérer la mémoire des variables objet
    Set Docu = Nothing
    Set objWord = Nothing
   On Error GoTo 0
   Exit Sub
CréerCompteRendu_Error:
    MsgBox "Erreur " & Err.Number & " (" & Err.Description & _
        ") ", vbCritical
'délocage du recalcul automatique:
Application.Calculation = xlCalculationAutomatic
 
End Sub
Dans le code ci-dessus les lignes :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
'Lancement de la macro insérant les graphiques
    objWord.Run "InséreUnGrapheExcelDansWord"
    objWord.Run "InséreUnTableauExcelDansWord"
lancent les macros du modèle .dot

Ces macros doivent insèrer dans le document des graphiques et tableaux situés dans un autre classeur :

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
Sub InséreUnGrapheExcelDansWord()
Dim XlAppli
Dim XlCl
Dim Xlfl
Dim Graphe
 
    Set XlAppli = CreateObject("Excel.Application") '< L'appli Excel
    Set XlCl = XlAppli.Workbooks.Open("C:\Documents and Settings\bertaudp\Mes documents\RCM_Auvergne Limousin\RCM_Auvergne Limousin\IRS\RCM_Evolution_IRS.xls") '< le classeur
        XlAppli.Calculate
        'Sleep 5000
        DoEvents
        'Sleep 5000
    Set Xlfl = XlCl.Worksheets("Evo_IRS_Agence") '< la feuille
    Set Graphe = Xlfl.ChartObjects(1) '< Le graphe 1
        Graphe.Chart.ChartArea.Copy
        DoEvents
        Selection.GoTo What:=wdGoToBookmark, Name:="GraphIRS"
        Selection.PasteAndFormat (wdChartPicture) 'Collage avec liaison
        DoEvents
 
    XlCl.Close False 'fermeture du fichier
    DoEvents
 
    'XlAppli.Quit 'Fermeture d'Excel
 
    Set Graphe = Nothing
    Set XlAppli = Nothing
    Set XlCl = Nothing
    Set Xlfl = Nothing
End Sub
L'import fonctionne seulement mon graphique n'est pas recalculé : une de ses valeurs sources est contenue dans mon premier classeur (celui dans lequel je lance la création du compte-rendu!).
Il faudrait que je puisse faire recalculé mon graphique avant de le copier pour l'insérer!
Quelqu'un à une idée ? (j'ai essayé Sleep et Application.Calculate sans succès!)