Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
 
Рейтинг 4.51/35: Рейтинг темы: голосов - 35, средняя оценка - 4.51
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
1

Как использовать макрос, который увеличивает/уменьшает картинку при щелчке на ней

26.06.2014, 22:40. Показов 6447. Ответов 31
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Внизу приведён макрос, который нашёл на просторах инета, и он почему-то не запускается.
А макрос должен увеличивать/уменьшать картинку при щелчке на ней!
У меня Microsoft Office 2007.
И правильно ли я добавил макрос?
Я выбрал в excel: Разработчик-Visual Basic, и потом в VBA выбрал Insert - Module, и ввёл этот код в окно модуля.
Картинка естественно есть в excelе.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub ZoomImage()
     ' Ìàêðîñ äëÿ óâåëè÷åíèÿ / óìåíüøåíèÿ êàðòèíîê â Excel, ïî ùåë÷êó íà íèõ
    ' © 2013 EducatedFool     ExcelVBA.ru/code/ZoomImages
 
     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 / 2: cy1# = .Top + .Height / 2
             dw# = .Width / STEPS_COUNT&
             dt# = ZOOM_SPEED# / 50 / STEPS_COUNT&
 
             For i& = 1 To STEPS_COUNT&    ' â öèêëå óìåíüøàåì êàðòèíêó
                t = Timer: .Width = .Width - dw#
                 .Left = cx1# - .Width / 2: .Top = cy1# - .Height / 2
                 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
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
26.06.2014, 22:40
Ответы с готовыми решениями:

Работа со строками: создать метод, который увеличивает или уменьшает дату на определённое количество дней
Создать метод, который увеличивает или уменьшает дату на определённое количество дней(передаётся во...

Макрос, который увеличивает значение ячейки А на 1 при изменении ячейки В
Добрый день. Я написал макрос, который увеличивает значение ячейки А на 1 при изменении ячейки...

Резидентная программа, которая при нажатии определенных клавиш уменьшает/увеличивает курсор
Здраствуйте! У меня возникла проблема с реализацией резидентной программы , которая при нажатии...

При щелчке на кнопку сменить текст на ней
Первый вопрос: Кнопка называется Старт, вот я нажал на неё, нужно что бы название поменялась на...

31
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
28.06.2014, 20:33 21
Author24 — интернет-сервис помощи студентам
Как видно по коду - там в настройках задано sha.LockAspectRatio = 1, поэтому Игорь увеличивает только ширину.
Нужно соблюдение пропорций отключить, и тогда можно увеличивать высоту чуть больше, чем ширину.
1
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
28.06.2014, 21:21  [ТС] 22
Цитата Сообщение от Hugo121 Посмотреть сообщение
и тогда можно увеличивать высоту чуть больше, чем ширину.
а где в коде её надо увеличивать?
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
28.06.2014, 21:40 23
55 строка кода.
0
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
28.06.2014, 22:09  [ТС] 24
Visual Basic
1
.Width = .Width + dw#: .Left = cx# - .Width / 2: .Top = cy# - .Height / 2
а конкретней можно?
В с++-подобных языках может быть и разобрался, но тут я потерял веру в человечество
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
28.06.2014, 22:16 25
Что конкретней? Задать за вас ещё и Height?
Вообще спросите автора кода - а то как-то некорректно... Автор ведь известен.
0
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
28.06.2014, 22:27  [ТС] 26
Цитата Сообщение от Hugo121 Посмотреть сообщение
Задать за вас ещё и Height?
перепробовал разные варианты с Height, не работает
0
es geht mir gut
11270 / 4752 / 1183
Регистрация: 27.07.2011
Сообщений: 11,439
28.06.2014, 22:30 27
Visual Basic
1
2
3
4
5
6
7
8
9
10
Sub ZoomImage()
     'Bla-bla-bla
      '............
      '...........
      'Bla-bla-bla
     'Добавьте следующие 3 строчки в конец макроса
     sha.LockAspectRatio = 0
     sha.Height = sha.Height * 1.2 'увеличиваем высоту в 1.2 раза
     sha.LockAspectRatio = 1
End Sub
1
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
28.06.2014, 22:34  [ТС] 28
SoftIce, благодарю
0
6922 / 2832 / 543
Регистрация: 19.10.2012
Сообщений: 8,645
28.06.2014, 22:36 29
А про sha.LockAspectRatio я уже говорил выше.
И я думал, что хотите при увеличении картинки растягивать её ввысь, а не просто тупо в конце высоту скачком увеличить.
0
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
29.06.2014, 16:55  [ТС] 30
теперь помогите пожалуйста переделать код, который приводил немного ранее для вставки рисунков в ячейки.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range("I:I,J:J,K:K"), Target) Is Nothing Then
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        With Selection
      .ShapeRange.LockAspectRatio = msoFalse
            .Width = Target.Width
            .Height = Target.Height
        End With
    End If
End If
End Sub
Надо чтобы макрос распространялся на все ячейки (не только на I,J,K), НО ещё чтобы этот макрос запускался правой кнопкой мыши, не левой кнопкой при наведении на ячейку!
0
5562 / 1368 / 150
Регистрация: 08.02.2009
Сообщений: 4,109
Записей в блоге: 30
29.06.2014, 17:07 31
Спасибо, phpk, за важную тему, но просто любопытно: вы макросы исключительно из интернета получаете?
0
27 / 41 / 13
Регистрация: 15.05.2013
Сообщений: 1,313
29.06.2014, 17:43  [ТС] 32
Цитата Сообщение от Sasha_Smirnov Посмотреть сообщение
Спасибо, phpk, за важную тему, но просто любопытно: вы макросы исключительно из интернета получаете?
да, но в VBA вообще не разбираюсь, а в данный момент понадобилось работать с excel вот и ищу нужный код!
1
29.06.2014, 17:43
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
29.06.2014, 17:43
Помогаю со студенческими работами здесь

Разработать функцию, которая уменьшает в N раз число, кратное N, а остальные увеличивает на единицу
Задача: Разработать функцию f(x), которая число, кратное 5, уменьшает в 5 раз, а остальные числа...

Макрос, который вставляет картинку в документ Word
Возникла следующая проблема, есть простой макрос, который вставляет графический файл, в документ,...

Padding уменьшает фоновую картинку
Когда в 20 строчке padding-top: 0, проблем не возникает и фоновая картинка растянута на всю высоту...

Плагин Magic Zoom уменьшает исходную картинку
Использую плагин Magic Zoom вот отсюда: https://www.magictoolbox.com/magiczoom/integration/ На...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
32
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru