Пакетная вставка рисунков в слайды PowerPoint с помощью VBA

У меня есть серия изображений («1.bmp», «2.bmp», «3.bmp», …, «30.bmp» в папке «F: Images»), и я пытаюсь вставить их изображения по одному в Microsoft PowerPoint с помощью программы VBA. Базовый слайд (как шаблон) установлен на странице 2. Объект изображения с именем Image1 в этом шаблоне слайд будет заменен на «F: Images 1.bmp», «F: Images 2.bmp» … отдельно в новых слайдах после базового слайда.

Экспериментальная реализация

Основной способ входа — InsertFigures.

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

Все предложения приветствуются.