Compress all the pictures to email size pixel (96)PPI by using command button

问题

I want to compress all the pictures in excel workbook to email size pixel 96( ppi) by using command button with the following code. But it doesn't work to compress all pictures .It can only compress 1 picture.

Sub test()

    Dim wsh As Worksheet

    Set wsh = Worksheets("Sheet1")
    wsh.Activate
    wsh.Shapes(1).Select

    SendKeys "%e", True
    SendKeys "~", True
    Application.CommandBars.ExecuteMso "PicturesCompress"

End Sub

回答1:

Try using a For Each loop to iterate through all shapes in the worksheet:

Sub test()

    Dim wsh As Worksheet
    Dim shp As Shape

    Set wsh = Worksheets("Sheet1")

    For Each shp In wsh.Shapes
        shp.Select
        SendKeys "%e", True
        SendKeys "~", True
        Application.CommandBars.ExecuteMso "PicturesCompress"
    Next shp

End Sub

来源：https://stackoverflow.com/questions/62053028/compress-all-the-pictures-to-email-size-pixel-96ppi-by-using-command-button