Mdify code...

[manulemalin]

Good morning,

I have the following code:
Public Sub CollageImage()

' procédure permettant la récupération de 4 images et l'incorporation dans un tableau sur une diapositive

' déclaration des variables
Dim strTabImage(1 To 4) As String ' tableau dans lequel nous stockerons le noms et le chemin du fichier
Dim objSld As Slide ' slide dans laquelle nous mettrons le tableau
Dim objShp As Shape ' pour parcourir les formes d'une diapositive et détecter le tableau
Dim objTable As Shape ' le tableau qui va servir de repère
Dim objImg As Shape ' image que l'on va ajouter
Dim objTitre As Shape ' titre de l'image que l'on va ajouter
Dim lngLeftPosImage As Long ' position de l'image
Dim lngWidthImage As Long ' largeur de l'image
Dim i As Integer


' récupération des images dans le tableau
For i = 1 To 4
' on lance une boite de dialogue permettant la récupération des fichiers jpg
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.Filters.Add "Images jpg", "*.jpg"
.Title = "Sélection l'image n° " & i
.Show
' on stocke les fichiers dans le tableau
strTabImage(i) = .SelectedItems(1)
End With
Next i

' on détecte le silde où on veut mettre les images, dans notre cas le premier
Set objSld = ActivePresentation.Slides(1)

' récupération du tableau
For Each objShp In objSld.Shapes
If objShp.Type = msoTable Then
Set objTable = objShp
End If
Next objShp

' on va ajouter nos images et les titres
For i = 1 To 4
lngLeftPosImage = objTable.Table.Rows(6).Cells(2 + (i - 1) * 3).Shape.Left
lngWidthImage = (objTable.Table.Rows(6).Cells(2).Shape.Width) * 3
Set objImg = objSld.Shapes.AddPicture(strTabImage(i), msoFalse, msoTrue, lngLeftPosImage, 80)
' retaillage de l'image
With objImg
.LockAspectRatio = msoTrue ' on bloque la proportion
.Width = lngWidthImage
End With
' on ajoute le titre de l'image au dessus de la première ligne du tableau
Set objTitre = objSld.Shapes.AddTextbox(msoTextOrientationHorizontal, lngLeftPosImage, objTable.Table.Rows(1).Cells(1).Shape.Top - 50, lngWidthImage, 50)
With objTitre
.TextFrame.TextRange.Text = Mid(strTabImage(i), InStrRev(strTabImage(i), "\") + 1)
.TextFrame.TextRange.Font.Size = 12
End With
Next i

End Sub



I have two main problems:

1- This code works only for slide 1 and if I add new slides it still paste images in the first slide

2 - If I have less than 4 images in a slide I can't paste them

Can somebody help me please ?

Thank you in advance

Manu