Copy/Paste CheckBoxes If True In PowerPoint

[casalerj]

I am trying to copy all true or checked boxes on all slides and paste them onto one slide within my presentation. I can't seem to figure it out. Below is the code that I am using. Any help is appreciated.


Sub ckbxCopy()
Dim shp As Shape
Dim sld As Slide
Dim i As Integer
On Error Resume Next
For Each sld In ActivePresentation.Slides
For i = 1 To 4
shp = ActivePresentation.Slides("CheckBox" & CStr(i))
If Err.Number = 0 Then ' shape exists
If shp.OLEFormat.Object.Value = True Then
shp.Copy
ActivePresentation.Slides(3).Shapes.Paste
End If
End If
Next i
Next sld
End Sub

[casalerj]

I think I figured it out...


Sub ckbxCopy()

Dim shp As Shape, pres As Presentation
Dim sld As Slide, sldDest As Slide
Dim i As Integer, t As Long

Set pres = ActivePresentation
Set sldDest = pres.Slides(5) 'where shapes are to be pasted

sldDest.Shapes.Range.Delete 'remove existing shapes
t = 72
For Each sld In pres.Slides
If sld.SlideIndex <> sldDest.SlideIndex Then
For i = 1 To 20
Set shp = Nothing
Set shp = SlideShape(sld, "CheckBox" & CStr(i))
If Not shp Is Nothing Then
If shp.OLEFormat.Object.Value = True Then
shp.Copy
pres.Slides(5).Shapes.Paste.Top = t 'paste and position
t = t + 30
End If
End If
Next i
End If
Next sld
End Sub


'Return a named shape from a slide (or Nothing if the shape doesn't exist)
Function SlideShape(sld As Slide, shapeName As String) As Shape
On Error Resume Next
Set SlideShape = sld.Shapes(shapeName)
End Function