Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Включение паузы внутри работающего скрипта. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Включение паузы внутри работающего скрипта. (Макросы/Sub)
Включение паузы внутри работающего скрипта.
Glass4217 Дата: Пятница, 01.03.2019, 05:14 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго времени суток.
Помогите решить задачу.

Есть макрос плавного перемещения круга по координатам из таблицы.
Однако этот круг - двигается сразу по всем представленным координатам - без остановки.

Посоветуйте - как изменить макрос, чтобы он после каждого перемещения к табличной координате - вставал на паузу, а по нажатию на кнопку - продолжал бы движение ?
(Когда круг пройдется по всем координатам, нужно чтобы макрос - как-то выдал сообщение msgbox "Конец" )
К сообщению приложен файл: 3463931.xlsm(24.0 Kb)
 
Ответить
СообщениеДоброго времени суток.
Помогите решить задачу.

Есть макрос плавного перемещения круга по координатам из таблицы.
Однако этот круг - двигается сразу по всем представленным координатам - без остановки.

Посоветуйте - как изменить макрос, чтобы он после каждого перемещения к табличной координате - вставал на паузу, а по нажатию на кнопку - продолжал бы движение ?
(Когда круг пройдется по всем координатам, нужно чтобы макрос - как-то выдал сообщение msgbox "Конец" )

Автор - Glass4217
Дата добавления - 01.03.2019 в 05:14
krosav4ig Дата: Пятница, 01.03.2019, 06:10 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2150
Репутация: 894 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Здравствуйте.
Как-то так
[vba]
Код
Option Explicit
Dim b As Boolean

...

Sub Obj1ToObj2_1(Obj1, Obj2, Optional Steps = 20)
  Const dt# = 0.02
  Dim x1#, x2#, y1#, y2#, x#, y#, t!
  Dim l1#, t1#, w1#, h1#, l2#, t2#, w2#, h2#
  Do: t = Timer: Do: DoEvents: Loop While Timer < t + dt: Loop While b
  With Obj1
    l1 = .Left: t1 = .Top: w1 = .Width: h1 = .Height
  End With
  l2 = Obj2(1, 1): t2 = Obj2(1, 2)
'  With Obj2
'    l2 = .Left: t2 = .Top: w2 = .Width: h2 = .Height
'  End With
  x1 = l1 + w1 / 2
  y1 = t1 + h1 / 2
  x2 = l2 ' + w2 / 2
  y2 = t2 ' + h2 / 2
  With Obj1
    For x = x1 To x2 Step (x2 - x1) / Steps
      y = (x2 * y1 - x1 * y2 - (y1 - y2) * x) / (x2 - x1)
      .Left = x - w1 / 2
      .Top = y - h1 / 2
      t = Timer + dt
      While Timer < t:  Wend
      DoEvents:
    Next
    x = x2: y = y2: .Left = x - w1 / 2: .Top = y - h1 / 2
  End With
  b = True
End Sub
Sub test()
    Dim lr&, i&, sTmp$
    On Error Resume goto err
    With Evaluate(Application.Caller)
        sTmp$ = .OnAction
        .OnAction = "toggle"
        With Лист1
            lr = .Cells(Rows.Count, "n").End(xlUp).Row
            For i = 6 To lr
                Obj1ToObj2_1 .Shapes("Oval 1"), .Cells(i, "n").Resize(, 2).Value
            Next i
        End With
err:    .OnAction = sTmp
    End With
    MsgBox "Конец"
End Sub
Private Sub toggle()
    b = Not b
End Sub
[/vba]
К сообщению приложен файл: 5451360.xlsm(26.2 Kb)


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

Сообщение отредактировал krosav4ig - Пятница, 01.03.2019, 06:58
 
Ответить
СообщениеЗдравствуйте.
Как-то так
[vba]
Код
Option Explicit
Dim b As Boolean

...

Sub Obj1ToObj2_1(Obj1, Obj2, Optional Steps = 20)
  Const dt# = 0.02
  Dim x1#, x2#, y1#, y2#, x#, y#, t!
  Dim l1#, t1#, w1#, h1#, l2#, t2#, w2#, h2#
  Do: t = Timer: Do: DoEvents: Loop While Timer < t + dt: Loop While b
  With Obj1
    l1 = .Left: t1 = .Top: w1 = .Width: h1 = .Height
  End With
  l2 = Obj2(1, 1): t2 = Obj2(1, 2)
'  With Obj2
'    l2 = .Left: t2 = .Top: w2 = .Width: h2 = .Height
'  End With
  x1 = l1 + w1 / 2
  y1 = t1 + h1 / 2
  x2 = l2 ' + w2 / 2
  y2 = t2 ' + h2 / 2
  With Obj1
    For x = x1 To x2 Step (x2 - x1) / Steps
      y = (x2 * y1 - x1 * y2 - (y1 - y2) * x) / (x2 - x1)
      .Left = x - w1 / 2
      .Top = y - h1 / 2
      t = Timer + dt
      While Timer < t:  Wend
      DoEvents:
    Next
    x = x2: y = y2: .Left = x - w1 / 2: .Top = y - h1 / 2
  End With
  b = True
End Sub
Sub test()
    Dim lr&, i&, sTmp$
    On Error Resume goto err
    With Evaluate(Application.Caller)
        sTmp$ = .OnAction
        .OnAction = "toggle"
        With Лист1
            lr = .Cells(Rows.Count, "n").End(xlUp).Row
            For i = 6 To lr
                Obj1ToObj2_1 .Shapes("Oval 1"), .Cells(i, "n").Resize(, 2).Value
            Next i
        End With
err:    .OnAction = sTmp
    End With
    MsgBox "Конец"
End Sub
Private Sub toggle()
    b = Not b
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 01.03.2019 в 06:10
Glass4217 Дата: Пятница, 01.03.2019, 07:17 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, а подскажите - как этот макрос работает ?
Если закрыть файл - когда круг пройдет по нескольким координатам из таблицы - то макрос при новом открытии файла - перестает работать.

Как это исправить ?
Сейчас фигура - с места не сдвигается.
К сообщению приложен файл: 5451360-2-.xlsm(25.4 Kb)


Сообщение отредактировал Glass4217 - Пятница, 01.03.2019, 07:20
 
Ответить
Сообщениеkrosav4ig, а подскажите - как этот макрос работает ?
Если закрыть файл - когда круг пройдет по нескольким координатам из таблицы - то макрос при новом открытии файла - перестает работать.

Как это исправить ?
Сейчас фигура - с места не сдвигается.

Автор - Glass4217
Дата добавления - 01.03.2019 в 07:17
krosav4ig Дата: Пятница, 01.03.2019, 08:17 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2150
Репутация: 894 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Как это исправить ?
В модуль ЭтаКника поместить код [vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Evaluate("Кнопка 5").OnAction = "test"
End Sub
[/vba] переназначить макрос кнопке или в окно immediate ввести [vba]
Код
Evaluate("Кнопка 5").OnAction = "test"
[/vba] и нажать Enter


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение
Как это исправить ?
В модуль ЭтаКника поместить код [vba]
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Evaluate("Кнопка 5").OnAction = "test"
End Sub
[/vba] переназначить макрос кнопке или в окно immediate ввести [vba]
Код
Evaluate("Кнопка 5").OnAction = "test"
[/vba] и нажать Enter

Автор - krosav4ig
Дата добавления - 01.03.2019 в 08:17
Glass4217 Дата: Пятница, 01.03.2019, 08:52 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 47
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
krosav4ig, теперь все заработало. Спасибо за ответ.


Сообщение отредактировал Glass4217 - Суббота, 02.03.2019, 01:26
 
Ответить
Сообщениеkrosav4ig, теперь все заработало. Спасибо за ответ.

Автор - Glass4217
Дата добавления - 01.03.2019 в 08:52
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Включение паузы внутри работающего скрипта. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!