Excelシートの選択範囲・選択グラフをパワーポイントにサクサク貼り付け

エクセルのシートの内容（セル範囲・オートシェイプ・グラフ）を、
開いているパワーポイントのスライドにサクサク貼り付けるマクロ。

複数シート＆複数範囲　を選択すると、
各選択範囲をループして一括で貼り付けます。

お作法完全無視の酷いコードですが共有。

※参照設定でパワーポイントオブジェクトの参照必須です。

    Dim yohaku, top_yohaku, mytitle
    Dim myrange, mybook, myppt
    Dim Tempslide, TempI
    Dim mySelections, mySRange
        
    '選択範囲をPPTに図として貼り付け
    Sub PastePPT_Pic()
        
        Dim PPT As New PowerPoint.Application
        If PPT.Presentations.Count >= 2 Or _
            PPT.Presentations.Count = 0 Then
            MsgBox "貼り付け先のパワーポイントを１つだけ開いて、やり直して下さい", vbCritical
            End
        End If
        
        '説明
        If MsgBox("【開いているPPT】の【選択中のスライド】をコピーして、" & vbCr & vbCr & _
                    "【エクセルの選択範囲】を【図として】貼り付けます。" & vbCr & vbCr & vbCr & vbCr & _
                    "※複数シート選択すると、一括処理できます。", vbOKCancel) = vbCancel Then End
        
        '設定
        yohaku = Application.InputBox("左右の余白は何ポイント？（初期設定：20）", , 20, , , , , 1)
        If yohaku = False Then End
        top_yohaku = Application.InputBox("上の余白は何ポイント？（初期設定：80）", , 80, , , , , 1)
        If top_yohaku = False Then End
        
        Set mybook = ActiveWorkbook
        
        TempI = 0
        
        '選択シートを後ろから順番に処理する。
        Set mysheets = ActiveWindow.SelectedSheets
        Application.ScreenUpdating = False
        For i = mysheets.Count To 1 Step -1
            mysheets(i).Select
            Set mySelections = Nothing
            Set myrange = Nothing
            one_flg = False
            
            If TypeName(Selection) = "Range" Then
                Set mySelections = Selection.Areas
                Set mySRange = Selection
            ElseIf TypeName(Selection) Like "Chart*" Then
                Set mySelections = Selection.Parent.Parent.ShapeRange
            Else
                Set mySelections = Selection.ShapeRange
            End If
            
            For j = mySelections.Count To 1 Step -1
                Set myrange = mySelections(j)
                If mySelections.Count = 1 Then
                    mytitle = ActiveSheet.Name
                Else
                    mytitle = ActiveSheet.Name & "_" & j
                End If
                Call PastePPT_Pic_Loop(PPT)
            Next
        Next
        
        Tempslide.Select
        
        'コピー元を選択しなおす
        If TypeName(mySelections(1)) = "Range" Then
            mySRange.Select
        ElseIf TypeName(mySelections(1)) Like "Chart*" Then
            mySelections(1).Select
        Else
            For Each myselect In mySelections
                myselect.Select False
            Next
        End If
        Application.ScreenUpdating = True
    End Sub
    
    '現在のスライド選択するテスト
    Sub test_getslide()
        Dim PPT As New PowerPoint.Application
        Set piyobook = ActiveWorkbook
        For i = 1 To 100
            Set Tempslide = Nothing
            piyobook.Activate
            PPT.Activate
            'テンプレスライド
            Do While TypeName(Tempslide) = "Empty" Or TypeName(Tempslide) = "Nothing"
                Sleep 100
                Set Tempslide = PPT.Windows(1).Selection.SlideRange
                Debug.Print i, Tempslide.Name
            Loop
        Next
    End Sub
    
    Private Sub PastePPT_Pic_Loop(PPT)
        Set myppt = PPT.Presentations(1)
        
        '貼り付け=======================================
        myrange.Select
        myrange.Copy
        
        PPT.Activate
        '選択中のスライドをテンプレスライドとする。
        TempI = PPT.Windows(1).Selection.SlideRange.SlideIndex
        Set Tempslide = PPT.ActivePresentation.Slides(TempI)
        
        '貼り付けスライド挿入
        Tempslide.Duplicate.MoveTo topos:=TempI + 1
        Set myslide = PPT.ActivePresentation.Slides(TempI + 1)
        swidth = myslide.CustomLayout.Width
        sheight = myslide.CustomLayout.Height - 5
        myslide.Select
        
        With myslide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)
            .LockAspectRatio = True
            .Top = top_yohaku
            If (sheight - top_yohaku) < .Height Then .Height = (sheight - top_yohaku)
            If (swidth - (yohaku * 2)) < .Width Then
                .Width = swidth - (yohaku * 2)
                .Left = yohaku
            Else
                .Left = (swidth - .Width) / 2
            End If
        End With
        myslide.Shapes.title.TextFrame.TextRange.Text = mytitle
    
        Application.CutCopyMode = False
    End Sub