全てのスライドで印刷範囲外にあるオブジェクト（のほとんど）を削除します．

目次

  1. 注意
  2. マクロ

注意

用紙の上に同じサイズのオブジェクトを置いて，重なっていないオブジェクトを削除対象としています．
このため，用紙の外にあるテキストボックスでフレームの端が用紙にかかっているものなどは生き残ってしまいます．

マクロ

Sub OuterShapeDeleter()

    slide_width = ActivePresentation.PageSetup.SlideWidth
    slide_height = ActivePresentation.PageSetup.SlideHeight
    
    For i = 1 To ActivePresentation.Slides.Count
        ActiveWindow.View.GotoSlide Index:=i
        
        Set rect = ActivePresentation.Slides(i).Shapes.AddShape(Type:=msoShapeRectangle, _
        Left:=0, Top:=0, Width:=slide_width, Height:=slide_height)
        
        For Each s In ActivePresentation.Slides(i).Shapes
            If ShapesSeparate(s, rect) Then
                s.Select Replace:=msoFalse
            End If
        Next
        
        On Error Resume Next
            ActiveWindow.Selection.ShapeRange.Delete
        On Error GoTo 0
        rect.Delete
    Next
    
    ActiveWindow.View.GotoSlide Index:=1
    MsgBox "欄外のオブジェクトを削除しました．"

End Sub

Function ShapesSeparate(s, t)
    flg = False
    
    s_top = s.Top
    s_left = s.Left
    s_bottom = s.Top + s.Height
    s_right = s.Left + s.Width
    t_top = t.Top
    t_left = t.Left
    t_bottom = t.Top + t.Height
    t_right = t.Left + t.Width
    
    'msgbox s_top & " " & s_left & " " & s_bottom & " " & s_right & vbcrlf & t_top & " " & t_left & " " & t_bottom & " " & t_right
    
    If s_bottom < t_top Then flg = True
    If t_bottom < s_top Then flg = True
    If s_right < t_left Then flg = True
    If t_right < s_left Then flg = True
    
    'msgbox flg
    
    ShapesSeparate = flg
End Function