Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Смена рисунков при наведении курсором, Смена рисунков макросом иль другим способом если это возможно
 
#1
19.12.2016 15:17:21
Доброе время суток, помогите с таким решением.. в поиске не искал потому как не могу как правильно это описать запросом..
Вообщем суть такова
должен получится типа "ролловер эффект в Excel " ну с пустыми ячейками что б я мог вводить данные
Вот как на видео

Файлы удалены: превышение допустимого размера вложения [МОДЕРАТОР]
 
 
 
#2
19.12.2016 15:22:07
напишите макрос, который при выделении ячейки отображает одну из 3 картинок (а остальные картинки скрывает)
изначально, все картинки поместите на лист одна поверх другой
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
19.12.2016 18:03:24
Нашел макрос по увеличению и скрытию картинки .. я не совсем разбираюсь в макросах, подскажите как мне привязать данное увеличения картинки не к картинке а к ячейке например D2
2 изображение к D4
3-е к D6

то есть что б при  активной ячейки  D2 увеличивалась картинка (маленькую картинку скрыть)

ссылка на файл (большой не могу прикрепить сюда)
Код
Sub ZoomImage()
   
    Const ZOOM_RATIO# = 3    ' коэффициент увеличения изображения
    Const STEPS_COUNT& = 20    ' количество промежуточных шагов при увеличении
    Const ZOOM_SPEED# = 2   ' скорость увеличения / уменьшения картинки ( от 0 до 10)

    On Error Resume Next: Err.Clear: Dim sha As Shape, s_sha As Shape, i&
    Set s_sha = ActiveSheet.Shapes(Application.Caller)
    If Err Then Exit Sub    ' выход, если макрос вызван не щелчком на картинке

    If s_sha.Name Like "BigImage_*" Then    ' щелчок на увеличенной картинке
        With s_sha
            cx1# = .Left + .Width / 3: cy1# = .Top + .Height / 4
            dw# = .Width / STEPS_COUNT&
            dt# = ZOOM_SPEED# / 50 / STEPS_COUNT&

            For i& = 1 To STEPS_COUNT&    ' в цикле уменьшаем картинку
                t = Timer: .Width = .Width - dw#
                .Left = cx1# - .Width / 3: .Top = cy1# - .Height / 3
                While Timer - t < dt#: DoEvents: Wend
            Next i
            .Delete    ' а потом удаляем её
        End With

    Else    ' щелчок на исходной картинке, - создаём её копию, и увеличиваем
        For Each sha In ActiveSheet.Shapes
            If sha.Name Like "BigImage_*" Then sha.Delete
        Next

        Set sha = s_sha.Duplicate    ' создаем копию картинки
        sha.Top = s_sha.Top: sha.Left = s_sha.Left    ' помещаем копию поверх исходной
        sha.Name = "BigImage_" & Timer    ' переименовываем изображение
        sha.LockAspectRatio = 1

        ' если есть закреплённые столбцы и строки
        TopRowsHeight# = Range("1:1").RowHeight    ' закреплена первая строка
        LeftColumnsWidth# = 0    ' закреплённых столбцов нет

        With sha
            cx1# = .Left + .Width / 2: cy1# = .Top + .Height / 2

            cx2# = Columns(ActiveWindow.ScrollColumn).Left - LeftColumnsWidth# + _
                   ActiveWindow.Width / 2 * 100 / ActiveWindow.Zoom
            cy2# = Rows(ActiveWindow.ScrollRow).Top - TopRowsHeight# + _
                   ActiveWindow.Height / 2 * 100 / ActiveWindow.Zoom

            dw# = .Width * (ZOOM_RATIO# - 1) / STEPS_COUNT&
            dx# = (cx2# - cx1#) / STEPS_COUNT&: dy# = (cy2# - cy1#) / STEPS_COUNT&
            cx# = cx1#: cy# = cy1#: dt# = ZOOM_SPEED# / 50 / STEPS_COUNT&

            For i& = 1 To STEPS_COUNT&
                t = Timer: cx# = cx# + dx#: cy# = cy# + dy#
                .Width = .Width + dw#: .Left = cx# - .Width / 2: .Top = cy# - .Height / 2
                While Timer - t < dt#: DoEvents: Wend
            Next i
        End With
    End If
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх