Exporter des images sous word

**Donutsdog** · 26/01/2011, 12h04

Bonjour,

A partir d’un bouton de commande, je souhaite créer un fichier word qui se remplira automatiquement en fonction des choix de l’utilisateur sous excel.
J’ai réussi à avoir du texte qui se rempli automatiquement au bon endroit dans le fichier word à l’aide des signet mais je n’arrive pas à faire copier des images. (J’arrive a faire copier des graphiques mais pas les images !)

Voici mon code :

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
'Création d'offre sous format word
Private Sub CommandButton1_Click()
    Dim offre As String
    Dim LeMontant As Integer
    Dim LeTexte2
    Dim ObjWord As Word.Application
    Dim LeDocWord As Word.Document
 
'If CommandButton1.Accelerator = "O" Then
On Error Resume Next
 
'Creation d'objet word et ouvrir le fichier sous Word
    offre = ThisWorkbook.Path & "\OFFRE_TECHNICO-ECONOMIQUE.doc"
    Set ObjWord = CreateObject("Word.Application")
    ObjWord.Visible = True
    Set LeDocWord = ObjWord.Documents.Open(offre)
 
With LeDocWord
If Cells(14, 7) = "Surimposition" Then
.Bookmarks("s32").Range.Text = "Pour ce projet nous vous proposons une structure support de surimposition fixée sur la toiture."
.Bookmarks("s33").Range.Text = "Figure 5. Illustration d'une structure en surimposition"
….
 
ThisWorkbook.Worksheets("bilan annuel").Activate
ActiveSheet.ChartObjects("graphique113").Activate
ActiveChart.ChartArea.Select
ActiveChart.ChartArea.Copy
.Application.Selection.PasteSpecial Link:=True
'End With
End If

J’ai aussi besoin de faire un collage spécial de grahiques sous power point (à partir de graphiques sous excel). Mais mon code (sous excel) qui me permet de faire des collages spécial dans word ne marche pas pour powerpoint !

Merci beaucoup pour l'aide que vous pourrez m'apporter !

**Godzestla** · 26/01/2011, 12h30

Pour colle rune image, ilf faut faire un paste special.

voici comment coller par exemple l'image d'un range de cellulles excels.

A adapter à tes besoins.

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
           Workbooks(Detailled_workbook).Sheets(Details_Sheet).Range(Bonus_Range_Detail).Copy
            Bonus_Word.Bookmarks("Target").Range.PasteSpecial _
             Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
 
'... Traitement
 
'Après il fait effacer le résultat du paste special si ce code est dans une boucle sinon le résultat est le cumul des différents paste special.
 
            ' Clear at "Target" bookmark position
            'Bonus_Word.Characters(Bonus_Word.Bookmarks("Target").Start + 1).Delete
            'Remove Inserted Contents at "Target" bookmark
             With Bonus_Word.Bookmarks("Target")
               Bookstart = .Start
               Bookend = .End
             End With

**Donutsdog** · 26/01/2011, 15h29

Merci de votre réponse.
Je ne comprends pas ce que signifient Detailled_workbook, Details_Sheet et Bonus_Range_Detail.
Est il possible que excel cherche une image dans un dossier et la copie dans word ou powerpoint ?

**Godzestla** · 26/01/2011, 16h20

Je ne comprends pas ce que signifient Detailled_workbook, Details_Sheet et Bonus_Range_Detail.

ce sont les noms de variables dans mon exemple (c'est un extrait d'un code que j'utilise.

Pour

Est il possible que excel cherche une image dans un dossier et la copie dans word ou powerpoint ?

,
regarde ici

**Donutsdog** · 27/01/2011, 12h36

Bonjour,

ça marche !! merci beaucoup.
Mais j'ai encore plusieurs difficultés : je n'arrive pas associer un bookmark de mon fichier word avec mes graphiques excel (en collage spécial).

Voici mon 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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
'Création d'offre sous format word
 
Sub ModifierWord()
 
Dim offre As String
Dim wdApp As Word.Application
Dim LeDocWord As Word.Document
Dim BMRange As Word.Range
Dim oShape As Word.InlineShape
 
 
Application.ScreenUpdating = False
 
Set wdApp = CreateObject("Word.Application")
Set LeDocWord = wdApp.Documents.Open(ThisWorkbook.Path & "\OFFRE_TECHNICO-ECONOMIQUE.doc")
 
'If CommandButton1.Accelerator = "O" Then
 
On Error Resume Next
 
'Creation d'objet word et ouvrir le fichier sous Word
 
With LeDocWord
 
'Le nom du signet dans le document word
 
'le type d'intégration
 
If Cells(14, 7) = "Surimposition" Then
.Bookmarks("s32").Range.Text = "Pour ce projet nous vous proposons une structure support de surimposition fixée sur la toiture."
.Bookmarks("s33").Range.Text = "Figure 5. Il...
 
...
 
On Error Resume Next
LeDocWord.Range.InlineShapes(1).Delete
On Error GoTo 0
LeDocWord.Bookmarks("Graph2").Range.InlineShapes.AddPicture Filename:=ThisWorkbook.Path & "\Graph2.jpg", LinkToFile:=False, SaveWithDocument:=True
 
 
ThisWorkbook.Sheets("bilan annuel").Range("graphique 113").Copy
LeDocWord.Bookmarks("graphique 113").Range.PasteSpecial _
Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine
 
'... Traitement
 
'Après il fait effacer le résultat du paste special si ce code est dans une boucle sinon le résultat est le cumul des différents paste special.
 
' Clear at "Target" bookmark position
'Bonus_Word.Characters(Bonus_Word.Bookmarks("Target").Start + 1).Delete
'Remove Inserted Contents at "Target" bookmark
 
With Bonus_Word.Bookmarks("graphique 113")
        Bookstart = .Start
        Bookend = .End
End With
 
'ThisWorkbook.Worksheets("bilan annuel").Activate
'ActiveSheet.ChartObjects("graphique 113").Activate
'ActiveChart.ChartArea.Select
'ActiveChart.ChartArea.Copy
'.Application.Selection.PasteSpecial Link:=True
'wdDoc.Bookmarks("Graph2").Range.InlineShapes.AddPicture Filename:=ThisWorkbook.Path & "\Graph2.jpg", LinkToFile:=False, SaveWithDocument:=True
'End With
 
'La Puissance installée
.Bookmarks("s0").Range.Text = Worksheets("Resumé").Range("c12").Value
 
'Titre de l'offre
With LeDocWord.Bookmarks("s1")
    .Range.Font.Size = 30
    .Range.Bold = True
    .Range.Text = Worksheets("Client").Range("d12").Value
    '.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
End With
 
 
' Non de la societé
    .Bookmarks("s2").Range.Text = Worksheets("Client").Range("d12").Value
    .Bookmarks("s3").Range.Text = Worksheets("Client").Range("d12").Value
    .Bookmarks("s4").Range.Text = Worksheets("Client").Range("d12").Value
 
...
 
End If
End With
 
'Pour enregistrer le document et quitter Word
'LeDocWord.Save
'LeDocWord.Close
wdApp.Quit
 
'Set wdApp = Nothing
'Kill ThisWorkbook.Path & "\Graph2.jpg"
Set LeDocWord = Nothing
MsgBox "Fichier Word crée !!", vbInformation
 
End Sub