Плавное увеличение автофигуры по щелчку.

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Плавное увеличение автофигуры по щелчку. (Макросы/Sub)

cerber412

Дата: Пятница, 10.03.2017, 01:59 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 131

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Доброе утро, уважаемые форумчане.
Помогите решить проблему.

У меня есть макрос - плавно увеличивающий или уменьшающий автофигуру на листе.
Но есть проблема: если нажать на кнопку "Увеличение" - то автофигура будет увеличиваться до бесконечности.
Ели же нажать на кнопку "Уменьшение" - то она будет уменьшаться до тех пор. пока не превратится в точку.

Как заставить макрос - плавно увеличить автофигуру - всего в два раза (кнопка "Увеличение") и плавно уменьшить эту автофигуру - тоже в два раза (кнопка "Уменьшение") ?

[vba]

Код

Sub ShapeUp()
    With ActiveSheet.Shapes(1)
        .LockAspectRatio = False
        NormH = .Height
        NormW = .Width
        For i = 1 To 400
            .Height = NormH * (1 + i / 10)
            .Width = NormW * (1 + i / 10)
            DoEvents
        Next
    End With
End Sub
Sub ShapeDown()
    With ActiveSheet.Shapes(1)
        .LockAspectRatio = False
        NormH = .Height
        NormW = .Width
        For i = 1 To 400
            .Height = NormH / (1 + i / 10)
            .Width = NormW / (1 + i / 10)
            DoEvents
        Next
    End With
End Sub

[/vba]

К сообщению приложен файл: 56853.xls (45.5 Kb)

Ответить

krosav4ig

Дата: Пятница, 10.03.2017, 03:23 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Здравствуйте. Как-то так можно
[vba]

Код

Sub ShapeUp()
    Dim i#, j#: j = 1
    With ActiveSheet.Shapes(1)
        .LockAspectRatio = 1
        For i = 1 To 2 Step 1 / 400
            .ScaleHeight i / j, 0, 0
            j = i: DoEvents
        Next
    End With
End Sub
Sub ShapeDown()
    Dim i#, j#: j = 1
    With ActiveSheet.Shapes(1)
        .LockAspectRatio = 1
        For i = 1 To 2 Step 1 / 400
            .ScaleHeight j / i, 0, 0
            j = i: DoEvents
        Next
    End With
End Sub

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Perfect2You

Дата: Пятница, 10.03.2017, 10:51 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 237

Репутация: 59 ±

Замечаний: 0% ±

Excel 2010

Можно всего лишь заменить везде, где встречается
[vba]

Код

(1 + i / 10)

[/vba]
10 на верхнюю границу цикла (в Вашем случае 400). Тогда при последнем значении переменной цикла коэффициент увеличения/уменьшения 1+400/400 - будет 2.

Сообщение отредактировал Perfect2You - Пятница, 10.03.2017, 10:54

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Плавное увеличение автофигуры по щелчку. (Макросы/Sub)

Страница 1 из 1
1