VBA Else If statement acting weird - vba

Question

Alright, so for a PHP script, i need all non-image objects to be converted to images (excluding text) from a .pptx file. As i have quite a lot .pptx files, i tought that i might as well use VBA.
For some reason however, my Else If is acting weird.
Sub nieuwemacro()
Dim oSl As Slide
Dim oSh As Shape
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
' MsgBox (oSh.Type)
' modify the following depending on what you want to
' convert
If oSh.Type = 1 Then
ConvertShapeToPic oSh
Else
End If
Next
Next
End Sub
Sub ConvertShapeToPic(ByRef oSh As Shape)
Dim oNewSh As Shape
Dim oSl As Slide
oSh.Fill.ForeColor.RGB = RGB(0, 0, 0)
Set oSl = oSh.Parent
oSh.Copy
Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)
With oNewSh
.Left = oSh.Left
.Top = oSh.Top
Do
.ZOrder (msoSendBackward)
Loop Until .ZOrderPosition = .ZOrderPosition
End With
oSh.Delete
End Sub
The oSh.Fill.ForeColor.RGB = RGB(0, 0, 0) part is just there to see what happens. And this is the result:
Alright.. So everything is converted properly, except for the big pink ball. So i thought i'd try some other Else ifs. My new Else If statement:
If oSh.Type = 1 Then
ConvertShapeToPic oSh
ElseIf oSh.Type = 14 Then
ConvertShapeToPic oSh
Else
End If
Resulting in this:
Notice how the code now doesnt convert the green bar at the top? It does that when i add or remove IfElse parts...
I don't know why it does this, could someone tell me what i'm doing wrong?

Answer 1

try this
Option Explicit
Sub nieuwemacro()
Dim oSl As Slide
Dim oSh As Shape
Dim oShs() As Shape
Dim nShps As Long, iShp As Long
For Each oSl In ActivePresentation.Slides
ReDim oShs(1 To oSl.Shapes.Count) As Shape
For Each oSh In oSl.Shapes
' MsgBox (oSh.Type)
' modify the following depending on what you want to
' convert
If oSh.Type = 1 Then
nShps = nShps + 1
Set oShs(nShps) = oSh
End If
Next
If nShps > 0 Then
For iShp = 1 To nShps
ConvertShapeToPic oShs(iShp)
Next iShp
End If
Next
End Sub
Sub ConvertShapeToPic(ByRef oSh As Shape)
Dim oNewSh As Shape
Dim oSl As Slide
oSh.Fill.ForeColor.RGB = RGB(0, 0, 0)
Set oSl = oSh.Parent
oSh.Copy
Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)
With oNewSh
.Left = oSh.Left
.Top = oSh.Top
Do
.ZOrder (msoSendBackward)
Loop Until .ZOrderPosition = .ZOrderPosition
End With
oSh.Delete
End Sub
You may also want to consider the following refactoring:
Option Explicit
Sub nieuwemacro()
Dim oSl As Slide
Dim oShs() As Shape
For Each oSl In ActivePresentation.Slides
oShs = GetShapes(oSl, msoAutoShape) '<--| gather shapes of given type and...
ConvertShapesToPics oShs '<--| ...convert them
Next
End Sub
Function GetShapes(oSl As Slide, shType As MsoShapeType) As Shape()
Dim oSh As Shape
Dim nShps As Long
With oSl.Shapes '<--| reference passed slide Shapes collection
ReDim oShs(1 To .Count) As Shape '<--| resize shapes array to referenced slide shapes number (i.e. to maximum possible)
For Each oSh In .Range '<--| loop through referenced slide shapes
If oSh.Type = shType Then '<--| if its type matches the passed one
nShps = nShps + 1 '<--| update gathered shapes counter
Set oShs(nShps) = oSh '<--| fill gathered shapes array
End If
Next
End With
If nShps > 0 Then '<--| if any shape has been gathered
ReDim Preserve oShs(1 To nShps) As Shape '<--| resize array properly ...
GetShapes = oShs '<--| ... and return it
End If
End Function
Sub ConvertShapesToPics(oShs() As Shape)
Dim iShp As Long
If IsArray(oShs) Then '<--| if array has been initialized ...
For iShp = 1 To UBound(oShs) '<--|... then loop through its elements (shapes)
ConvertShapeToPic oShs(iShp) '<--| convert current shape
Next iShp
End If
End Sub
Sub ConvertShapeToPic(ByRef oSh As Shape)
With oSh '<--| reference passed shape
.Fill.ForeColor.RGB = RGB(0, 0, 0) '<--| change its forecolor
.Copy '<--| copy it
With .Parent.Shapes.PasteSpecial(ppPastePNG)(1) '<--| reference pasted shape
.Left = oSh.Left '<--| adjust its Left position
.Top = oSh.Top '<--| adjust its Top position
Do
.ZOrder (msoSendBackward)
Loop Until .ZOrderPosition = .ZOrderPosition
End With
.Delete '<--| delete referenced passed shape
End With
End Sub
Finally, you may want to shorten down "main" sub by two lines more like follwos
Sub nieuwemacro()
Dim oSl As Slide
For Each oSl In ActivePresentation.Slides
ConvertShapesToPics GetShapes(oSl, msoAutoShape) '<--| convert shapes of given type
Next
End Sub
where GetShapes(), ConvertShapesToPics() and ConvertShapeToPic() stays the same.