junty94 | C'est bon, j'ai réussi à faire la macro.. donc si ca interesse quelqu'un :
pour info, elle prends toutes les images situées dans C:\aaa\h (images horizontales) et C:\aaa\v (images verticales). Les redimensionnements d'images sont prévus pour des tailles originales de 2048 x 1536 (photos numériques 3 Mpixels)
En esperant que ca puisse servir
Code :
- Sub newdiapoinsertimg()
- Dim Myfile
- Dim i As Integer
- Dim cheminh As String
- Dim cheminv As String
- i = 1
- Myfileh = Dir("C:\aaa\h\" & "*.jpg" )
- Do While Myfileh <> ""
- With ActivePresentation.Slides
- .Add .Count + 1, ppLayoutBlank
- End With
- ActiveWindow.View.GotoSlide (i)
- i = i + 1
- Myfileh = "C:\aaa\h\" & Myfileh
- ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Myfileh, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=8, Top:=8, Width:=702, Height:=527).Select
- Myfileh = Dir
- Loop
- Myfilev = Dir("C:\aaa\v\" & "*.jpg" )
- Do While Myfilev <> ""
- With ActivePresentation.Slides
- .Add .Count + 1, ppLayoutBlank
- End With
- ActiveWindow.View.GotoSlide (i)
- i = i + 1
- Myfilev = "C:\aaa\v\" & Myfilev
- ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Myfilev, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=162, Top:=8, Width:=395, Height:=527).Select
- Myfilev = Dir
- Loop
- If ActivePresentation.HasTitleMaster Then
- With ActivePresentation.TitleMaster.Background
- .Fill.Visible = msoTrue
- .Fill.ForeColor.SchemeColor = ppForeground
- .Fill.Transparency = 0#
- .Fill.Solid
- End With
- End If
- With ActivePresentation.SlideMaster.Background
- .Fill.Visible = msoTrue
- .Fill.ForeColor.SchemeColor = ppForeground
- .Fill.Transparency = 0#
- .Fill.Solid
- End With
- With ActivePresentation.Slides.Range
- .FollowMasterBackground = msoTrue
- .DisplayMasterShapes = msoTrue
- End With
- End Sub
|
|