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

Вход

Регистрация

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

 

= Мир MS Excel/Объединение двух макросов смены картинок - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Объединение двух макросов смены картинок
odeon16 Дата: Понедельник, 16.10.2017, 14:47 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 85
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый вечер.
Помогите с решением.

У меня есть макрос смены картинки, вписанной в автофигуру - при щелчке по кнопке.
И есть макрос анимации - смены картинки на листе - по таймеру.

Подскажите - как объединить эти скрипты, чтобы по таймеру менялась вписанная в фигуру картинка ?

[vba]
Код

Public Sub www()
    Static p&
    Dim c As Range
    p = IIf(p > 2, 1, p + 1)
    Application.ScreenUpdating = 0
    Me.DrawingObjects.Delete
    With Pictures.Insert(ThisWorkbook.Path & "\" & p & ".jpg")
    .Left = 300: .Top = 10: End With
  
    Application.ScreenUpdating = -1

    
       If Selection.Address <> "$A$1" Then Application.OnTime Now + TimeValue("00:00:01"), "Лист3.www"
End Sub
[/vba]

[vba]
Код

Sub Макрос1()

Set Obj = ActiveSheet.Shapes("Прямоугольник 4")
With Obj
    With .Fill
        .Visible = msoTrue
        .UserPicture Range("I4")
        .TextureTile = msoFalse
    End With
    .Select
    CommandBars.ExecuteMso ("PictureFitCrop")
    Cells(.TopLeftCell.Row, .TopLeftCell.Column).Select
End With

End Sub
[/vba]
К сообщению приложен файл: 32456.rar (70.2 Kb)
 
Ответить
СообщениеДобрый вечер.
Помогите с решением.

У меня есть макрос смены картинки, вписанной в автофигуру - при щелчке по кнопке.
И есть макрос анимации - смены картинки на листе - по таймеру.

Подскажите - как объединить эти скрипты, чтобы по таймеру менялась вписанная в фигуру картинка ?

[vba]
Код

Public Sub www()
    Static p&
    Dim c As Range
    p = IIf(p > 2, 1, p + 1)
    Application.ScreenUpdating = 0
    Me.DrawingObjects.Delete
    With Pictures.Insert(ThisWorkbook.Path & "\" & p & ".jpg")
    .Left = 300: .Top = 10: End With
  
    Application.ScreenUpdating = -1

    
       If Selection.Address <> "$A$1" Then Application.OnTime Now + TimeValue("00:00:01"), "Лист3.www"
End Sub
[/vba]

[vba]
Код

Sub Макрос1()

Set Obj = ActiveSheet.Shapes("Прямоугольник 4")
With Obj
    With .Fill
        .Visible = msoTrue
        .UserPicture Range("I4")
        .TextureTile = msoFalse
    End With
    .Select
    CommandBars.ExecuteMso ("PictureFitCrop")
    Cells(.TopLeftCell.Row, .TopLeftCell.Column).Select
End With

End Sub
[/vba]

Автор - odeon16
Дата добавления - 16.10.2017 в 14:47
  • Страница 1 из 1
  • 1
Поиск:

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