Макрос изменения размера изображения в Excel

Question

У меня есть макрос, в котором я изменяю размер изображения. Что должно произойти: изображение находится внутри ячейки, и когда я нажимаю на него, когда оно увеличивается, и когда я нажимаю его снова, оно возвращается в нормальное состояние. Но когда я щелкаю изображение, чтобы вернуть его в нормальное состояние, его нет, выходит из ячейки. Код ниже и изображение, чтобы увидеть, что происходит, когда я щелкаю изображение

Sub Picture1_Click()
Dim shp As Shape
    Dim big As Single, small As Single
    Dim shpDouH As Double, shpDouOriH As Double
    big = 3
    small = 1

    On Error Resume Next
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp
        shpDouH = .Height
        .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
        shpDouOriH = .Height
     
        If Round(shpDouH / shpDouOriH, 2) = big Then
            .ScaleHeight small, msoTrue, msoScaleFromTopLeft
            .ScaleWidth small, msoTrue, msoScaleFromTopLeft
            .ZOrder msoSendToBack
        Else
            .ScaleHeight big, msoTrue, msoScaleFromTopLeft
            .ScaleWidth big, msoTrue, msoScaleFromTopLeft
            .ZOrder msoBringToFront
        End If
    End With

End Sub

введите описание изображения здесь

Как я могу вернуть изображение к тому, что было раньше?

Answer 1

Проблема в вашем коде - это использование ScaleHeight. Этот метод изменяет размер изображения относительно его текущего размера, поэтому .ScaleHeight 1, msoTrue, msoScaleFromTopLeft ничего не делает; он в основном изменяет размер изображения до того размера, который у него уже есть.

Подробнее о ScaleHeight здесь: Метод Shape.ScaleHeight (Excel)

По мере написания кода shpDouH всегда будет равно shpDouOriH, что означает, что Round(shpDouH / shpDouOriH, 2) всегда будет вычислять точно 1. Это побеждает ваши If ... Then ... Else logi c. Каждый раз, когда вы щелкаете, размер изображения будет увеличиваться в 3 раза; он никогда не сжимается.

Самый простой способ уменьшить изображение до его исходных размеров - это указать максимальные размеры для неувеличенного изображения. Затем вы можете использовать тест по строкам If shp.Height > MaxHeight Then. В концепции basi c, если текущая высота меньше MaxHeight, то масштабируется в 3 раза; иначе масштабируется в 1/3 раза. Это должно сработать, если все исходные изображения примерно одинакового размера.

В противном случае вам нужно будет выбрать метод записи исходных размеров перед увеличением каждого изображения.