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
| Sub Remplacer_Images_Liées()
Dim oSldSource As Slide
Dim oShpImg As ShapeRange
Dim oShpSource As Shape
Dim oPicture As Shape
For Each oSldSource In Rapport.Slides
'MsgBox oSldSource.SlideNumber
For Each oShpSource In oSldSource.Shapes
'If oSldSource.SlideNumber <= 3 Then MsgBox "Slide" & " " & oSldSource.SlideNumber & " " & oShpSource.ZOrderPosition & " " & oShpSource.Type
If oShpSource.Type = msoLinkedPicture Then
'If oSldSource.SlideNumber <= 4 Then MsgBox oShpSource.Type
With oShpSource
Fichier = .LinkFormat.SourceFullName
Nom = .Name
PosG = .Left
PosH = .Top
Haut = .Height
Large = .Width
End With
oShpSource.Slides(n).Active
oShpSource.Delete
Set oPicture = oSldSource.Shapes.AddPicture(Fichier, _
msoFalse, msoTrue, 1, 1, 1, 1)
With Rapport.PageSetup
oPicture.Left = PosG
oPicture.Top = PosH
oPicture.Height = Haut
oPicture.Width = Large
Facteur = Haut / oPicture.Height
oPicture.ScaleHeight Facteur, msoFalse
End With
' MsgBox fichier
End If
Next oShpSource
Next oSldSource
End Sub |
Partager