Bonjour,
j'ai une présentation avec les images .pjg qui sont liées.
Ces images sont modifiés par une macro et donc la présentation a toujours les dernières images crées.
Mais une fois par semaine je veux archiver une version de la présentation et donc remplacer les images liées par une copie de cette image.

Tout ce passe bien sauf que à la place de limage j'ai un cadre vert
Voici mon code en espérant que l'un d'entre vous puisse m'aider.

D'avance merci.

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