Consulting

Results 1 to 2 of 2

Thread: Copy/Paste CheckBoxes If True In PowerPoint

  1. #1
    VBAX Newbie
    Joined
    Sep 2022
    Posts
    3
    Location

    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

  2. #2
    VBAX Newbie
    Joined
    Sep 2022
    Posts
    3
    Location
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •