Discussion :

[e040098k]

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

[Daranc]

Salut
ne peut tu pas lier le graphique à la source de données?

[e040098k]

Non car je génère 20 compte rendu à la suite et donc 20 graphique différent!

[Godzestla]

Bonjour,

as-tu essayé la démarche inversée , à savoir ouvrir ton modèle word depuis excel et puis revenir en excel ou tu exécutes un code VBA qui ouvre ton fichier excel avec le graphe et le copie dans dans le document word ouvert.

Avec ce système, il devrait calculer ton graphique.

[e040098k]

J'ai bien essayé ca mais il me met une erreur (Erreur 1004 : erreur définie par l'application ou par l'objet)sur la ligne :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Application.Workbooks.Open ("C:\Documents and Settings\bertaudp\Mes documents\RCM_Auvergne Limousin\RCM_Auvergne Limousin\IRS\RCM_Evolution_IRS.xls") '< le classeur
DoEvents
 
Sheets("Evo_IRS_Agence").Select '< la feuille
Set Graphe = Sheets("Evo_IRS_Agence").ChartObjects(1) ' Graphe.Chart.ChartArea.Copy
DoEvents
 
objWord.Activate
 
objWord.ActiveDocument.Bookmarks("GraphIRS").Select
Selection.PasteSpecial DataType:=wdPasteBitmap
'Selection.Paste 'AndFormat (wdChartPicture) 'Collage image
DoEvents

[Godzestla]

Je ne vois pas sur quelle ligne tu as l'erreur.

peux-tu repréciser ?

merci.

[e040098k]

Excuses moi!

J'ai une erreur au moment de coller, sur cette ligne :

Code :

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

Selection.PasteSpecial DataType:=wdPasteBitmap

[Godzestla]

Salut essaie ceci.

Code :

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

1
2
 
objWord.PasteSpecial DataType:=wdPasteBitmap

Attention que si tu boucles sur ce code, tes différents paste vont se cumuler et bonjour la cata .

Si c'est le cas, il faut supprimer le résultat du pastespecial après avoir sauvé/imprimé.... le document word.

Voici un exemple avec bouclage. Reviens si tu ne comprends pas .

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
 
For Idx = 2 To lrow
            ....
            Bonus_Word.Bookmarks("Target").Range.PasteSpecial _
             Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
            Bonus_Word.PrintOut
            ' Clear at "Target" bookmark position
            'Remove Inserted Contents at "Target" bookmark
             With Bonus_Word.Bookmarks("Target")
               Bookstart = .Start
               Bookend = .End
             End With
 
            Set Myrange = Bonus_Word.Range(Start:=Bookstart, End:=Bookend)
              Myrange.Delete
            End If
 
 
    Next Idx

[e040098k]

Ca ne fonctionne toujours pas!

[Godzestla]

peux-tu essayer la syntaxe que je propose dans mon exemple avec bouclage.

Code :

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

1
2
3
 
            Bonus_Word.Bookmarks("Target").Range.PasteSpecial _
             Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine

donc pour toi, quelques changements :
* tu enlèves ton select du bookmark qui se trouve avant et tu le met dans l'instruction pastespecial
* tu remplaces wdPasteBitmap par wdPasteOLEObject
*..

a voir si les autres parametres sont nécessaires.

Si cela ne marche pas, montre moi tout ton code.

[ouskel'n'or]

Tu dois remplacer Selection par l'objet Application. Si ObjWord est le document, ça ne peut pas fonctionner.
Ensuite, pour coller une "image" de ton graphe, et non ton graphe, c'est

Code :

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

WdApp.PasteAndFormat (wdChartPicture)

où wdApp est l'instance de l'application.
A toutes fins utiles

[ouskel'n'or]

Je n'ai pas enregistré tout de suite mais tu as plusieurs problèmes. Word ne reconnais pas les argument passés depuis Excel, tu dois utiliser leurs valeurs.
Par exemple, pour atteindre le signet, tu dois mettre -1 et non "wdGoToBookmark"
De même Placement:=0 insère le graphe sur la ligne du signet.
Je te mets un code qui fonctionne

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
Sub CopierCollerGrapheDansWord()
Dim FL1 As Worksheet
Dim WdApp As Object
Dim WdDoc
    Set FL1 = Worksheets("Feuil1")
    Set WdApp = CreateObject("Word.Application")
    Set WdDoc = WdApp.Documents.Open(Filename:="D:\Doc\Doc1.doc")
    DoEvents
    WdApp.Visible = False
    WdApp.Selection.GoTo What:=-1, Name:="Signet"
    FL1.Shapes(FL1.Shapes.Count).Copy
    WdApp.Selection.PasteSpecial Link:=False, DataType:=3, _
        Placement:=0 
    DoEvents
    WdDoc.Close True
    DoEvents
    WdApp.Quit
    Set WdApp = Nothing
    Set WdDoc = Nothing
End Sub

L'objet copié est un "Shape", ici le dernier créé.
Tu sauras adapter ?

[e040098k]

Nikel ! Ta solution focntionne à merveille, c'est pile poil ce dont j'avais besoins !

MERCI !!!!!