Discussion :

[ptibiscuit31]

Bonjour,
Je débute en VBA powerpoint et je cherche a réaliser une macro pour me faciliter une horrible tâche... Devoir transformer en PNG toutes les images de plusieurs PPT sur plusieurs slides.

J'ai commencé a essayer de construire quelques chose :

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
 
Sub conversion()
Dim sld As Slide
Dim shp As Shape
 
    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
     If shp.Type = msoPicture Then
      position_h = shp.Left
      position_v = shp.Top
      shp.Copy
      sld.Shapes.PasteSpecial ppPastePNG
 
      sld.Shapes(1).Left = position_h
      sld.Shapes(1).Top = position_v
 
      shp.Delete
 
      End If
    Next shp
    Next sld
End Sub

C'est pour le moment très bancale et bugué car actuellement elle convertie surtout la première image qu'elle rencontre sur une slide et déplace aussi des zones de textes... Pourriez vous m'aider s'il vous plait ?

Je vois bien que je ne maitrise pas comment "jouer" avec se qui vient d'être créée par le collage spéciale et comment lui dire de positionner cet élément collé exactement à la même place que l'image d'origine , sld.Shapes(1) est faux je suppose il faudrait plutôt lui dire "cette élément que tu viens de coller place le là".

Il existe peut être une autre solution qu'un copier collé spéciale puis effacer

[E KERGRESSE]

Bonjour,

A tester :

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
 
Sub conversion2()
 
Dim sld As Slide
Dim I As Integer
Dim shpN As Shape
Dim position_h As Double, position_v As Double
 
    For Each sld In ActivePresentation.Slides
        With sld
            For I = .Shapes.Count To 1 Step -1
                With .Shapes(I)
                    If .Type = msoPicture Then
                         Debug.Print .Type
                         position_h = .Left
                         position_v = .Top
                         .Copy
 
                         sld.Shapes.PasteSpecial ppPastePNG
 
                         Set shpN = sld.Shapes(sld.Shapes.Count)
                         shpN.Left = position_h
                         shpN.Top = position_v
                         Set shpN = Nothing
 
                         .Delete
 
                    End If
                End With
 
             Next I
         End With
    Next sld
 
End Sub