excel VBA 図の圧縮

図の圧縮サンプルプログラム

Dim sp As Shape

Dim l As Double

Dim t As Double

    For Each sp In ActiveSheet.Shapes

        If sp.Type = msoPicture Then

            l = sp.Left

            t = sp.Top

            sp.Select

            Selection.Cut

            ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False

            DoEvents

            With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

                .Left = l

                .Top = t

            End With

        End If

    Next