Sub PickItUp()
' Written by:     John Wilson & Technology Trish
' Select an autoshape and run and it applies that shape's 
'     format to all autoshapes.
' Select a text box, apply to all text boxes
' Select a picture with a border, apply to all pictures
' Doesn't work with placeholders or slide show items by design

    On Error GoTo ErrorHandler

    Dim oSld As Slide
    Dim oSelShp As Shape
    Dim oShp As Shape
    Dim lType As Long

    ' Results are unpredictable if you start with
    ' more than one shape selected, so don't permit it
    If ActiveWindow.Selection.ShapeRange.Count <> 1 Then
        MsgBox "Please select one and only one shape"
        Exit Sub
    End If

    ' set a reference to the selected shape
    Set oSelShp = ActiveWindow.Selection.ShapeRange(1)

    With oSelShp
        ' pick up its formatting
        .PickUp
        ' store its type
        lType = .Type

        ' Exclude placeholders
        If lType = 14 Then
            Exit Sub
        End If

        If .Fill.Type = msoFillPicture Then
            Exit Sub
        End If

        For Each oSld In ActivePresentation.Slides
            For Each oShp In oSld.Shapes
                If oShp.Type = lType Then
                    If oShp.Fill.Type <> msoFillPicture Then
                        oShp.Apply
                    End If  ' <> msoFillPicture
                End If  ' Type - lType
            Next oShp
        Next oSld
    End With    ' oSelShp

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox ("Sorry there's an error - Is anything selected?")
    Resume NormalExit:
End Sub