Ajouter image dans PPTX via OpenXML
Bonjour à tous,
Je réalise actuellement un export automatique en powerpoint.
J'ouvre mon template "template2.pptx", le duplique, le modifie et l'enregistre en "result.pptx". En fonction d'une textbox que le template contient, je détermine une action à réaliser comme insérer une image dans le slide.
Malheureusement, j'ai l'erreur "There was an error accessing "E:\TEST_EXPORT\PPTX\result.pptx" ". Impossible d'ouvrir le doc avec Powerpoint.
Voici mon code :
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
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
Dim relationShipId As String = ""
relationShipId = "rId" + (s.Elements(Of DocumentFormat.OpenXml.Presentation.Picture)().Count + 12).ToString
Dim imgPart As ImagePart = slp.AddImagePart(ImagePartType.Png, relationShipId)
Dim fs As FileStream = New FileStream("E:\TEST_EXPORT\PPTX\image1.png", FileMode.Open)
imgPart.FeedData(fs)
fs.Close()
'<p:pic>
Dim pic As DocumentFormat.OpenXml.Presentation.Picture = _
New DocumentFormat.OpenXml.Presentation.Picture()
s.Save(slp)
'<p:pic><p:BlipFill>
Dim bf As DocumentFormat.OpenXml.Presentation.BlipFill = _
New DocumentFormat.OpenXml.Presentation.BlipFill()
Dim blip As Blip = New Blip()
blip.Embed = relationShipId
Dim srcRect As SourceRectangle
srcRect = New SourceRectangle()
bf.Append(srcRect)
Dim stretch As Stretch = New Stretch()
Dim fillRect As FillRectangle = New FillRectangle()
stretch.Append(fillRect)
bf.Append(blip)
bf.Append(stretch)
'BLIP EXTENSION LIST ???
pic.Append(bf)
'Shape Properties
'Noeud ShapeProperties
Dim spPr As DocumentFormat.OpenXml.Presentation.ShapeProperties = _
New DocumentFormat.OpenXml.Presentation.ShapeProperties()
'Noeud ShapeProperties > Transform2D
Dim aXfrm As DocumentFormat.OpenXml.Drawing.Transform2D = _
New DocumentFormat.OpenXml.Drawing.Transform2D()
Dim off As DocumentFormat.OpenXml.Drawing.Offset = _
New DocumentFormat.OpenXml.Drawing.Offset()
off.X = 1485900 '1554691
off.Y = 1385888 '1600200
Dim ext As DocumentFormat.OpenXml.Drawing.Extents = _
New DocumentFormat.OpenXml.Drawing.Extents()
ext.Cx = 6172200 '6034617 '(img.Width / img.HorizontalResolution) * 914400L
ext.Cy = 4086225 '4525963 '(img.Height / img.VerticalResolution) * 914400L
aXfrm.Append(off)
aXfrm.Append(ext)
'Noeud ShapeProperties > PresetGeometry
Dim prstGeom As DocumentFormat.OpenXml.Drawing.PresetGeometry = _
New DocumentFormat.OpenXml.Drawing.PresetGeometry()
prstGeom.Preset = ShapeTypeValues.Rectangle
Dim avLst As DocumentFormat.OpenXml.Drawing.AdjustValueList = _
New DocumentFormat.OpenXml.Drawing.AdjustValueList()
prstGeom.Append(avLst)
Dim nofill As NoFill
nofill = New NoFill()
spPr.Append(nofill)
spPr.Append(aXfrm)
spPr.Append(prstGeom)
pic.Append(spPr)
'Fin Noeud ShapeProperties
'Noeud(NonVisualPictureProperties)
Dim nvPicPr As DocumentFormat.OpenXml.Presentation.NonVisualPictureProperties = _
New DocumentFormat.OpenXml.Presentation.NonVisualPictureProperties()
Dim nvDraPr As DocumentFormat.OpenXml.Presentation.NonVisualDrawingProperties = _
New DocumentFormat.OpenXml.Presentation.NonVisualDrawingProperties()
nvDraPr.Id = "3074"
nvDraPr.Name = "Picture 2"
nvDraPr.Description = objectId
Dim nvPicDraPr As DocumentFormat.OpenXml.Presentation.NonVisualPictureDrawingProperties = _
New DocumentFormat.OpenXml.Presentation.NonVisualPictureDrawingProperties()
Dim picLocks As DocumentFormat.OpenXml.Drawing.PictureLocks
picLocks = New DocumentFormat.OpenXml.Drawing.PictureLocks()
picLocks.NoChangeAspect = True
picLocks.NoChangeArrowheads = True
nvPicDraPr.Append(picLocks)
Dim appNvDraPr As DocumentFormat.OpenXml.Presentation.ApplicationNonVisualDrawingProperties = _
New DocumentFormat.OpenXml.Presentation.ApplicationNonVisualDrawingProperties
nvPicPr.Append(nvDraPr)
nvPicPr.Append(nvPicDraPr)
nvPicPr.Append(appNvDraPr)
pic.Append(nvPicPr)
'Fin Noeud NonVisualPictureProperties
'Ajout de la picture au shapetree
spt.Append(pic)
'suppression du slide part contenant la textbox
sp.Remove() |
Mon OpenXmlValidator, lui, ne me détecte pas d'erreur ???
