1
votes

I have a VBA module in Excel that deletes Powerpoint slides. The code is as follows:

    Function MyRange(ByVal StartIndex As Long, ByVal StopIndex As Long) As Variant
        Dim A() As Long
        Dim I As Long
        ReDim A(StartIndex To StopIndex)
        For I = StartIndex To StopIndex: A(I) = I: Next
        MyRange = A End Function

Sub RemoveUnwantedSlides()
            ActivePresentation.Slides.Range(MyRange(94, 101)).Delete
            ActivePresentation.Slides.Range(MyRange(85, 92)).Delete
            ActivePresentation.Slides.Range(MyRange(76, 83)).Delete
End Sub

However, I would like for the code to which slide numbers to delete, depending on the current value of a specific cell in Excel. Let's say that "1" is in cell A1, then only slides 94-101 should be deleted. If "2" is in cell A1, then only slides 85-92 should be deleted. If "3" is in cell A1, only slides 76-83 should be deleted.

How can I insert the current macro in an IF statement? Thank you

I've adapted to the following but it's not working:

Sub RemoveUnwantedSlides()
Dim A() As Long
        Dim I As Long
        ReDim A(StartIndex To StopIndex)
        For I = StartIndex To StopIndex: A(I) = I: Next
        MyRange = A

'The file name and path of the file to update
sourceFileName = "C:\Users\Children.pptm"
Set pptApp = New PowerPoint.Application
Set pptPresentation = pptApp.Presentations.Open(sourceFileName)

pptApp.Activate

Dim ppSlidesArr As Variant

Select Case Range("A1").Value
    Case 1
        ppSlidesArr = MyRange(64, 65)

    Case 2
        ppSlidesArr = MyRange(85, 92)

    Case 3
        ppSlidesArr = MyRange(76, 83)

End Select

ActivePresentation.Slides.Range(ppSlidesArr).Delete

End Sub

It's giving me a "Run-time error 429: 'ActiveX component can't create object" Also, how would I go about if I wanted to delete specific slides, instead of a range? Thank you

1

1 Answers

0
votes

Try the code below, you can use Select Case to make the code more adjustable for future scenarios:

Sub RemoveUnwantedSlides()

Dim ppSlidesArr As Variant

Select Case Range("A1").Value
    Case 1
        ppSlidesArr = MyRange(94, 101)

    Case 2
        ppSlidesArr = MyRange(85, 92)

    Case 3
        ppSlidesArr = MyRange(76, 83)

End Select

ActivePresentation.Slides.Range(ppSlidesArr).Delete

End Sub