Сожмите все изображения в пиксель (96) PPI по электронной почте с помощью кнопки управления

Question

Я хочу сжать все изображения в книге Excel до размера 96 пикселей (ppi) по электронной почте, используя командную кнопку со следующим кодом. Но сжать все картинки не получается, можно сжать только 1 картинку.

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

Answer 1

Попробуйте использовать For Each l oop для перебора всех фигур на листе:

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