Страница 1 из 1
Как заменить 49 макросов на один?
Добавлено: 11 ноя 2009, 13:53
Андрей45
Уважаемые программисты! Помогите чайнику!
У меня есть в Excel 49 прямоугольничков, они называются "Прямоугольник 1", "Прямоугольник 2" и т. д. При нажатии на прямоугольник надо, чтобы х становился равным номеру прямоугольника. У меня для этого 49 программ. Можно ли это сделать за одну? Заранее спасибо!
Мои макросы выглядят так:
Sub Прямоугольник1_Щелчок()
x = 1
Vybor (x) ' Запускается подпрограмма Vybor
End Sub
Re: Как заменить 49 макросов на один?
Добавлено: 11 ноя 2009, 14:12
EducatedFool
Для запуска макроса в этом случае удобно использовать не прямоугольники, а ячейки листа.
Двойной щелчок по ячейке - и в определённой ячейке появится соответствующее значение.
Вот пример:
Пощелкайте (двойной щелчок) на зелёных кнопках.
Вот весь код:
Код: Выделить всё
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_BeforeDoubleClick([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range, Cancel [color=darkblue]As[/color] [color=darkblue]Boolean[/color])
[color=darkblue]If[/color] Intersect(Target, [a2:j2]) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Or[/color] Target.Cells.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
[c5] = Target: Cancel = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
Re: Как заменить 49 макросов на один?
Добавлено: 11 ноя 2009, 14:14
Андрей45
EducatedFool писал(а):Для запуска макроса в этом случае удобно использовать не прямоугольники, а ячейки листа.
Двойной щелчок по ячейке - и в определённой ячейке появится соответствующее значение.
А с прямоугольниками никак? Они у меня красивые - перекрашиваются потом в разные цвета. Тем более, что под ними - фон с картинкой.
Re: Как заменить 49 макросов на один?
Добавлено: 11 ноя 2009, 14:29
EducatedFool
Ну почему же никак? Всё возможно
Выделяете все свои прямоугольники, щелкаете правой кнопкой - выбираете пункт
Назначить макрос
Макрос используйте типа такого:
Код: Выделить всё
[color=darkblue]Sub[/color] test()
[color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
[color=darkblue]Dim[/color] sha [color=darkblue]As[/color] Shape: [color=darkblue]Set[/color] sha = ActiveSheet.Shapes(Application.Caller)
[c2] = Right(sha.TextFrame.Characters.Text, 1)
[color=darkblue]For[/color] [color=darkblue]Each[/color] shap [color=darkblue]In[/color] ActiveSheet.Shapes
shap.Fill.BackColor.RGB = vbGreen
[color=darkblue]Next[/color]
sha.Fill.BackColor.RGB = vbRed
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
возвращает имя автофигуры (прямоугольника), вызвавшей макрос.
Вот что у меня получилось:
Re: Как заменить 49 макросов на один?
Добавлено: 11 ноя 2009, 14:44
Андрей45
А можетe написать комментарии к каждой строчке, а то у меня не получается? Мне надо просто - щелкнули - получили номер, присвоили иксу этот номер. Мне не надо перекрашивать - я это в другом месте делаю.
О!!! Спасибо большое! Я догадался! У меня заработало!
Мой макрос:
Sub test()
imya = Application.Caller
x = Mid(imya, 14)
Vybor (x)
End Sub
Всего-то!
Re: Как заменить 49 макросов на один?
Добавлено: 13 ноя 2009, 07:18
SAS888
Ели Вы пишете код только для себя, то можно и так. А если для других пользователей, то я бы не рисковал использовать x = Mid(imya, 14), т.к. в разных языковых вариантах Excel количество символов в имени одной и той же автофигуре может быть разным.
Надежнее так: