I have a series of images ("1.bmp", "2.bmp", "3.bmp",... ,"30.bmp" in "F:\Images" folder) and I am trying to insert these images one by one into Microsoft PowerPoint with VBA program. The base slide (as template) has been set down in page 2. The image object which is named
Image1 in that template slide is going to be replaced into "F:\Images\1.bmp", "F:\Images\2.bmp"... separately in new slides after the base slide.
The experimental implementation
The main entry method is
Sub InsertFigures() 'Reference: (Show object name) https://stackoverflow.com/a/52088805 'Reference: (Replace image) https://stackoverflow.com/a/18083223 Dim BaseSlideNumber As Integer Dim StartNum, EndNum As Integer StartNum = 1 EndNum = 30 BaseSlideNumber = 2 Dim LoopNumber As Integer For LoopNumber = StartNum To EndNum Set newSlide = ActivePresentation.Slides(BaseSlideNumber).Duplicate Next LoopNumber For LoopNumber = StartNum To EndNum NewPictureFilename = "F:\Images\" & CStr(LoopNumber) & ".bmp" ' Source Image Path Dim TargetSlideNumber As Integer TargetSlideNumber = BaseSlideNumber + (LoopNumber - StartNum + 1) Set ObjectForGettingProperties = getShapeByName("Image1", TargetSlideNumber) 'Capture properties of exisitng picture such as location and size With ObjectForGettingProperties TopProperty = .Top LeftProperty = .Left HeightProperty = .Height WidthProperty = .Width 'SoftEdgeProperty = .SoftEdge End With ObjectForGettingProperties.Delete ' Delete origin placeholder Set NewImageObject = ActivePresentation.Slides(TargetSlideNumber).Shapes.AddPicture(NewPictureFilename, msoFalse, msoTrue, LeftProperty, TopProperty, WidthProperty, HeightProperty) NewImageObject.Name = "NewImage" ' Set image name NewImageObject.SoftEdge.Radius = 8.86 Next LoopNumber End Sub Function getShapeByName(shapeName As String, Slide As Integer) 'Reference: https://stackoverflow.com/a/5527604 Set getShapeByName = ActivePresentation.Slides(Slide).Shapes(shapeName) End Function
All suggestions are welcome.