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

Вход

Регистрация

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

 

= Мир MS Excel/Загрузка файлов jpg с временным интервалом. - Мир MS Excel

Старая форма входа
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка файлов jpg с временным интервалом. (Макросы/Sub)
Загрузка файлов jpg с временным интервалом.
odeon16 Дата: Пятница, 15.09.2017, 06:22 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброе утро, уважаемые специалисты.
Помогите решить непростой вопрос.

У меня есть макрос добавляющий картинку с адреса в ячейке I4 - в фигуру "Прямоугольник 4".

Как заставить макрос - загружать фотофайлы в этой автофигуре с интервалом в 50 секунд - с бесконечным повторением - в соответствии с нумерацией файлов в папке ?

(сперва идет 1.jpg на 50 секунд, затем загружается 2.jpg на 50 секунд, затем загружается 3.jpg на 50 секунд, а затем цикл повторяется и так до бесконечности)
К сообщению приложен файл: 567858.rar (79.5 Kb)


Сообщение отредактировал odeon16 - Пятница, 15.09.2017, 19:40
 
Ответить
СообщениеДоброе утро, уважаемые специалисты.
Помогите решить непростой вопрос.

У меня есть макрос добавляющий картинку с адреса в ячейке I4 - в фигуру "Прямоугольник 4".

Как заставить макрос - загружать фотофайлы в этой автофигуре с интервалом в 50 секунд - с бесконечным повторением - в соответствии с нумерацией файлов в папке ?

(сперва идет 1.jpg на 50 секунд, затем загружается 2.jpg на 50 секунд, затем загружается 3.jpg на 50 секунд, а затем цикл повторяется и так до бесконечности)
Автор - odeon16
Дата добавления - 15.09.2017 в 06:22
buchlotnik Дата: Пятница, 15.09.2017, 07:35 | Сообщение № 2
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
[vba]
Код
Application.OnTime
[/vba]или [vba]
Код
Application.Wait
[/vba]
 
Ответить
Сообщение[vba]
Код
Application.OnTime
[/vba]или [vba]
Код
Application.Wait
[/vba]
Автор - buchlotnik
Дата добавления - 15.09.2017 в 07:35
odeon16 Дата: Пятница, 15.09.2017, 18:36 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
buchlotnik, как должен выглядеть макрос - хотя бы для одного из этих действий ?
Как должен выглядеть код - загружающий jpg по номерам в названиях и зацикливающий порядок загрузки ?
 
Ответить
Сообщениеbuchlotnik, как должен выглядеть макрос - хотя бы для одного из этих действий ?
Как должен выглядеть код - загружающий jpg по номерам в названиях и зацикливающий порядок загрузки ?
Автор - odeon16
Дата добавления - 15.09.2017 в 18:36
buchlotnik Дата: Пятница, 15.09.2017, 19:04 | Сообщение № 4
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
odeon16, какой вопрос, такой и ответ, я, например, не вижу ваш
Цитата
макрос добавляющий картинку с адреса в ячейке I4 - в фигуру "Прямоугольник 4"
и не знаю как производится
Цитата
нумерацией файлов в папке

а так ловите, конечно: [vba]
Код
Sub go()
    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    With Selection.ShapeRange.Fill
        Do
            For i = 1 To 3
                .Visible = msoTrue
                .UserPicture "адрес_папки" & i & ".JPG"
                 Application.Wait (Now + TimeValue("0:00:50"))
            Next i
        Loop
    End With
End Sub
[/vba]


Сообщение отредактировал buchlotnik - Пятница, 15.09.2017, 19:33
 
Ответить
Сообщениеodeon16, какой вопрос, такой и ответ, я, например, не вижу ваш
Цитата
макрос добавляющий картинку с адреса в ячейке I4 - в фигуру "Прямоугольник 4"
и не знаю как производится
Цитата
нумерацией файлов в папке

а так ловите, конечно: [vba]
Код
Sub go()
    ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select
    With Selection.ShapeRange.Fill
        Do
            For i = 1 To 3
                .Visible = msoTrue
                .UserPicture "адрес_папки" & i & ".JPG"
                 Application.Wait (Now + TimeValue("0:00:50"))
            Next i
        Loop
    End With
End Sub
[/vba]
Автор - buchlotnik
Дата добавления - 15.09.2017 в 19:04
odeon16 Дата: Пятница, 15.09.2017, 19:54 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
buchlotnik, ясно.
А как применить к этому случаю Application.OnTime ?
 
Ответить
Сообщениеbuchlotnik, ясно.
А как применить к этому случаю Application.OnTime ?
Автор - odeon16
Дата добавления - 15.09.2017 в 19:54
buchlotnik Дата: Пятница, 15.09.2017, 20:27 | Сообщение № 6
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
odeon16, в справку слазать слабо? вашего кода я не увидел ни строчки
 
Ответить
Сообщениеodeon16, в справку слазать слабо? вашего кода я не увидел ни строчки
Автор - buchlotnik
Дата добавления - 15.09.2017 в 20:27
odeon16 Дата: Пятница, 15.09.2017, 20:31 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
buchlotnik, в первом сообщении я привел пример.
 
Ответить
Сообщениеbuchlotnik, в первом сообщении я привел пример.
Автор - odeon16
Дата добавления - 15.09.2017 в 20:31
buchlotnik Дата: Пятница, 15.09.2017, 20:44 | Сообщение № 8
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
odeon16, чем не устроил код из сообщения №4?
 
Ответить
Сообщениеodeon16, чем не устроил код из сообщения №4?
Автор - buchlotnik
Дата добавления - 15.09.2017 в 20:44
odeon16 Дата: Пятница, 15.09.2017, 20:58 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Цитата buchlotnik, 15.09.2017 в 20:44, в сообщении № 8 ()
чем не устроил код из сообщения №4?


Этот код - во время ожидания (все 50 секунд) - не дает работать в экселе.
Постоянно отображается - на курсоре - то что выполняется программа.
И в экселе в это время - ничего нельзя сделать - ни ячейку выделить, ни фигуру нарисовать.
 
Ответить
Сообщение
Цитата buchlotnik, 15.09.2017 в 20:44, в сообщении № 8 ()
чем не устроил код из сообщения №4?


Этот код - во время ожидания (все 50 секунд) - не дает работать в экселе.
Постоянно отображается - на курсоре - то что выполняется программа.
И в экселе в это время - ничего нельзя сделать - ни ячейку выделить, ни фигуру нарисовать.
Автор - odeon16
Дата добавления - 15.09.2017 в 20:58
buchlotnik Дата: Пятница, 15.09.2017, 21:18 | Сообщение № 10
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Цитата
ничего нельзя сделать
а где эти хотелки были раньше? и, главное, ничего, что vba язык чутка процедурный, выполняется линейно и ессно не даст ничего делать?
 
Ответить
Сообщение
Цитата
ничего нельзя сделать
а где эти хотелки были раньше? и, главное, ничего, что vba язык чутка процедурный, выполняется линейно и ессно не даст ничего делать?
Автор - buchlotnik
Дата добавления - 15.09.2017 в 21:18
odeon16 Дата: Пятница, 15.09.2017, 21:28 | Сообщение № 11
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
buchlotnik, ясно.
Так как же все-таки реализовать этот алгоритм при помощи Application.OnTime ?
 
Ответить
Сообщениеbuchlotnik, ясно.
Так как же все-таки реализовать этот алгоритм при помощи Application.OnTime ?
Автор - odeon16
Дата добавления - 15.09.2017 в 21:28
buchlotnik Дата: Пятница, 15.09.2017, 21:32 | Сообщение № 12
Группа: Заблокированные
Ранг: Участник клуба
Сообщений: 3442
Репутация: 929 ±
Замечаний: 20% ±

2010, 2013, 2016 RUS / ENG
Цитата
при помощи Application.OnTime
залезть в справку и вынуть оттуда пример кода (в гугле msdn первой ссылкой вылезает)
 
Ответить
Сообщение
Цитата
при помощи Application.OnTime
залезть в справку и вынуть оттуда пример кода (в гугле msdn первой ссылкой вылезает)
Автор - buchlotnik
Дата добавления - 15.09.2017 в 21:32
odeon16 Дата: Пятница, 15.09.2017, 23:50 | Сообщение № 13
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
buchlotnik, да примеров-то с Application.OnTime - я кучу накачал.

Только они в данном макросе не работают.
Как только применяю макрос с Application.OnTime - все намертво зависает.
 
Ответить
Сообщениеbuchlotnik, да примеров-то с Application.OnTime - я кучу накачал.

Только они в данном макросе не работают.
Как только применяю макрос с Application.OnTime - все намертво зависает.
Автор - odeon16
Дата добавления - 15.09.2017 в 23:50
RAN Дата: Суббота, 16.09.2017, 07:32 | Сообщение № 14
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Dim lTimerID As Long
Dim b As Boolean
' Запуск
Sub Start_It()
    lTimerID = SetTimer(0&, 0&, 2000&, AddressOf Main)
End Sub

' Останов
Sub Stop_It()
    KillTimer 0&, lTimerID
End Sub

Sub Main()
    Dim s
    b = Not b
    s = IIf(b, "i1", "i2")
    On Error Resume Next
    ActiveSheet.DrawingObjects.Delete
    ActiveSheet.Pictures.Insert ("C:\Users\OFIS\Pictures\" & s & ".png")
End Sub
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long

Dim lTimerID As Long
Dim b As Boolean
' Запуск
Sub Start_It()
    lTimerID = SetTimer(0&, 0&, 2000&, AddressOf Main)
End Sub

' Останов
Sub Stop_It()
    KillTimer 0&, lTimerID
End Sub

Sub Main()
    Dim s
    b = Not b
    s = IIf(b, "i1", "i2")
    On Error Resume Next
    ActiveSheet.DrawingObjects.Delete
    ActiveSheet.Pictures.Insert ("C:\Users\OFIS\Pictures\" & s & ".png")
End Sub
[/vba]
Автор - RAN
Дата добавления - 16.09.2017 в 07:32
odeon16 Дата: Суббота, 16.09.2017, 08:32 | Сообщение № 15
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
RAN, внешне - код выглядит круто.

А он с бесконечным повторением ?
 
Ответить
СообщениеRAN, внешне - код выглядит круто.

А он с бесконечным повторением ?
Автор - odeon16
Дата добавления - 16.09.2017 в 08:32
RAN Дата: Суббота, 16.09.2017, 10:18 | Сообщение № 16
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Конечно нет. Достаточно выключить компьютер, и он перестанет работать. :D

Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеКонечно нет. Достаточно выключить компьютер, и он перестанет работать. :D
Автор - RAN
Дата добавления - 16.09.2017 в 10:18
odeon16 Дата: Суббота, 16.09.2017, 11:20 | Сообщение № 17
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
RAN, ясно.
Буду разбираться.
Спасибо за ответ.
 
Ответить
СообщениеRAN, ясно.
Буду разбираться.
Спасибо за ответ.
Автор - odeon16
Дата добавления - 16.09.2017 в 11:20
KuklP Дата: Суббота, 16.09.2017, 12:52 | Сообщение № 18
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Вариант с ontime, в модуль листа:
[vba]
Код
Public Sub www()
    Static p&
    p = IIf(p > 2, 1, p + 1)
    Debug.Print p
    Me.DrawingObjects.Delete
    Me.Pictures.Insert (ThisWorkbook.Path & "\" & p & ".jpg")
    Application.OnTime Now + TimeValue("00:00:01"), "Лист1.www"
End Sub

Public Sub stopSlideshow()
    Dim varNextCall
    varNextCall = Now + TimeValue("00:00:01")
    Application.OnTime varNextCall, "Лист1.www", , 0
End Sub
[/vba]

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Сообщение отредактировал KuklP - Суббота, 16.09.2017, 13:05
 
Ответить
СообщениеВариант с ontime, в модуль листа:
[vba]
Код
Public Sub www()
    Static p&
    p = IIf(p > 2, 1, p + 1)
    Debug.Print p
    Me.DrawingObjects.Delete
    Me.Pictures.Insert (ThisWorkbook.Path & "\" & p & ".jpg")
    Application.OnTime Now + TimeValue("00:00:01"), "Лист1.www"
End Sub

Public Sub stopSlideshow()
    Dim varNextCall
    varNextCall = Now + TimeValue("00:00:01")
    Application.OnTime varNextCall, "Лист1.www", , 0
End Sub
[/vba]
Автор - KuklP
Дата добавления - 16.09.2017 в 12:52
odeon16 Дата: Суббота, 16.09.2017, 21:59 | Сообщение № 19
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
KuklP, выглядит здорово.
Но вставляется - не в какое-то постоянное место на листе, а в ту ячейку, которая выделена на текущий момент.

То есть работать при этом включенном макросе тоже сложно, но уже по другой причине.

И еще - когда я пытаюсь остановить этот макрос (stopSlideshow) - он выдает ошибку 400.


Сообщение отредактировал odeon16 - Суббота, 16.09.2017, 22:16
 
Ответить
СообщениеKuklP, выглядит здорово.
Но вставляется - не в какое-то постоянное место на листе, а в ту ячейку, которая выделена на текущий момент.

То есть работать при этом включенном макросе тоже сложно, но уже по другой причине.

И еще - когда я пытаюсь остановить этот макрос (stopSlideshow) - он выдает ошибку 400.
Автор - odeon16
Дата добавления - 16.09.2017 в 21:59
KuklP Дата: Суббота, 16.09.2017, 22:32 | Сообщение № 20
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
И кто Вам мешает после вставки переместить картинку куда надо? А чтоб не мельтешило, отключить обновление экрана.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеИ кто Вам мешает после вставки переместить картинку куда надо? А чтоб не мельтешило, отключить обновление экрана.
Автор - KuklP
Дата добавления - 16.09.2017 в 22:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Загрузка файлов jpg с временным интервалом. (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

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