CODEWITHSUNDEEP
vbapowerpointpowerpoint-2016
casaler
casaler

Reputation: 41

Copy/Paste CheckBoxes If True In PowerPoint

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`

Upvotes: 0

Views: 133

Answers (1)

Tim Williams
Tim Williams

Reputation: 166316

This works for me:

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(3)    'where shapes are to be pasted
    
    sldDest.Shapes.Range.Delete 'remove existing shapes
    t = 20
    For Each sld In pres.Slides
        If sld.SlideIndex <> sldDest.SlideIndex Then
            For i = 1 To 4
                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(3).Shapes.Paste.Top = t 'paste and position
                        t = t + 20
                    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

Upvotes: 0

Related Questions