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() |
Partager