Discussion :

[cyb125]

Bonjour,

j'ai un dossier C:/Photos, dans lequel se trouvent des sous dossiers C:/Photos/sous-dossier1 , sous-dossier2 ... etc

j'aimerai faire une macro qui me fasse automatiquement une présentation de type "album photo" pour chaque sous-dossier. donc si j'ai 20 sous-dossiers, 20 présentations ppt.

je n'ai pas réussi à automatiser la fonction album photo avec vba, donc pour l'instant je l'ai fait comme ça ( avec 4 photos par slide) :

Sub Montage()

Dim sFichier As String, sRep As String, sPath As String, sNF As String
Dim I As Integer
sRep = "C:/PHOTOS/sous-dossier1/"
sPath = sRep & "*.jpg"
sFichier = Dir(sPath)
I = 1
ActivePresentation.Slides.Add 1, ppLayoutBlank
Do While sFichier <> ""
sNF = sRep & sFichier
ActiveWindow.Selection.SlideRange.Layout = ppLayoutBlank
ActiveWindow.Selection.SlideRange.Shapes.AddPicture FileName:=sNF, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=40, Top:=40, Height:=214.75, Width:=286.5
sFichier = Dir
If sFichier = "" Then Exit Do
I = I + 1
sNF = sRep & sFichier
ActiveWindow.Selection.SlideRange.Layout = ppLayoutBlank
ActiveWindow.Selection.SlideRange.Shapes.AddPicture FileName:=sNF, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=370, Top:=40, Height:=214.75, Width:=286.5
sFichier = Dir
If sFichier = "" Then Exit Do
I = I + 1
sNF = sRep & sFichier
ActiveWindow.Selection.SlideRange.Layout = ppLayoutBlank
ActiveWindow.Selection.SlideRange.Shapes.AddPicture FileName:=sNF, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=40, Top:=290, Height:=214.75, Width:=286.5
sFichier = Dir
If sFichier = "" Then Exit Do
I = I + 1
sNF = sRep & sFichier
ActiveWindow.Selection.SlideRange.Layout = ppLayoutBlank
ActiveWindow.Selection.SlideRange.Shapes.AddPicture FileName:=sNF, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=370, Top:=290, Height:=214.75, Width:=286.5
sFichier = Dir
If sFichier = "" Then Exit Do
I = I + 1
ActivePresentation.Slides.Add 1, ppLayoutBlank
ActiveWindow.View.GotoSlide 1
Loop
ActivePresentation.Slides.Add 1, ppLayoutBlank
MsgBox "Fini"
End Sub

J'aimerai donc automatiser cette tâche pour tous les sous-dossiers du dossier Photo. Est ce possible ? attention, les sous-dossiers ont des noms complètement aléatoires, rien de générique.
Je précise aussi qu'il me faut une présentation différente par sous-dossier.
Et enfin j'aimerai que chaque présentation s'enregistre avec le même nom que le sous-dossier correspondant...

merci pour votre aide

[Harry Covair]

Bonjour,

Ce lien apportera une réponse à la question

J'aimerai donc automatiser cette tâche pour tous les sous-dossiers du dossier Photo.

http://<br /> http://vb.developpez....rs#rep_sousrep

Bonne journée
Harry