Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA. Плавное перемещение картинки на UserForm, Нужен цикл на плавное перемещение картинки за 3 секунды
 
#1
10.07.2024 15:28:30
Скрытый текст
Пробовал через Application.Wait - задержка. Работает не корректно.
Нашел похожее в просторах инета, но тут Loop на постоянную и по всей userform картинка передвигается. Переписать двигать из пункта А в пункт В мозгов не хватило:
Код
Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
Do
Label1 = Format(Date, "dddd, dd mmm yyyy")
Label2 = Format(Time, "hh:mm:ss AM/PM")
Label3.Left = Label3.Left - 2
If Label3.Left <= 0 - Label3.Width Then Label3.Left = Me.Width
For i = 1 To 8000000
Next
DoEvents
Loop
End Sub
Изменено: Sanja - 10.07.2024 15:32:41 (Изменил название темы)
 
 
 
#2
10.07.2024 15:33:42
Тут лучше конечно иметь файл-пример, для тестирования.
Согласие есть продукт при полном непротивлении сторон
 
 
 
#3
10.07.2024 16:02:33
Кнопка CommandButton4 двигает картинку
 
 
 
#4
10.07.2024 18:32:17
Так пункт А и пункт Б - это что/где на форме? Откуда и куда Вы хотите изображение двигать? Обозначьте какие-то объекты-якоря например, а тогда уже и о перемещении между пунктами говорить можно будет.
Что касается Вашего кода - добавьте в цикл DoEvents, и на форме картинка будет визуально перемещаться.
Изменено: VladZ - 10.07.2024 19:14:49
 
 
 
#5
11.07.2024 07:39:38
Пункт А объекта Image2.Left =-204, Пункт В объекта Image2.Left =12
 
 
 
#6
11.07.2024 09:22:46
Ну тогда DoEvents Вам будет достаточно. Для плавности можно еще небольшой цикл-задержку туда же вставить.
Изменено: VladZ - 11.07.2024 09:25:18
 
 
 
#7
11.07.2024 12:27:18
Попробовал такое, но картинка при движении все равно дергается (меняет цвет):
Код
Image5.Left = -204
For i = -204 To 12
DoEvents
i = i + 0.00000005
DoEvents
Image5.Left = i
DoEvents
Application.Wait Now + ((TimeValue("00:00:01") / 1000) * 200)
DoEvents
 
 
 
#8
11.07.2024 14:44:27
Мигания полностью никак не избежать - так криво сделана перерисовка картинки в Excel
Ради интереса потратил полчаса, что только не пробовал, мерцание полностью не убирается (и картинку менял, и все её свойства)
Иногда (с другой картинкой) помогает незначительное изменение высоты картинки, например, с 558 до 550 px

Код замените на такой:

Код
Private Sub CommandButton4_Click()
    Image2.Left = -204
    For i = -204 To 12 Step 3
        Image2.Left = i
        For j = 1 To 4000: DoEvents: Next
    Next
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#9
11.07.2024 16:11:41
Цитата
написал:
  Image2.Left = -204
   For i = -204 To 12 Step 3
       Image2.Left = i
       For j = 1 To 4000: DoEvents: Next
   Next
Спасибо, Игорь! Этот вариант лучше, чем с задержкой времени. Скорее всего от объема картинки много зависит. Попробую уменьшить качество.
 
 
 
#10
11.07.2024 16:15:41
Ещё помню на форме помогает Me.Repaint или репайнт конкретного фрейма
Цитата
Remarks
The Repaint method is useful if the contents or appearance of an object changes significantly, and you don't want to wait until the system automatically repaints the area.
Изменено: Hugo - 11.07.2024 16:18:11
 
 
 
#11
11.07.2024 20:45:41
я пробовал и Repaint (но он тут не в тему, - тут все перерисовывается и без того)
тут задача, скорее, отключать repaint этот (а такой возможности нет)
Можно ещё попробовать картинку другого формата (типа BMP под нужный размер), чтобы перерисовка выполнялась быстрее.

Пока писал ответ, придумал решение (Hugo подсказал словом фрейм) — стал пробовать вместо Image другие контролы (картинку-то вставить можно во что угодно, в Label например)
И внезапно решение нашлось — вместо элемента Image используем Frame (отключив рамку и очистив Caption, с виду всё будет как у контрола Image)
У Frame перерисовка не глючит, картинка плавно выплывает

Код будет такой: (поменять Image2 на Frame1, и тайминги с шагом)
Код
Private Sub CommandButton4_Click()
    Frame1.Left = -204
    For i = -204 To 200 Step 2
        Frame1.Left = i
        For j = 1 To 1000: DoEvents: Next
    Next
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
Страницы: 1
Читают тему
Наверх