Как заменить 49 макросов на один?

[Андрей45]

Уважаемые программисты! Помогите чайнику!
У меня есть в Excel 49 прямоугольничков, они называются "Прямоугольник 1", "Прямоугольник 2" и т. д. При нажатии на прямоугольник надо, чтобы х становился равным номеру прямоугольника. У меня для этого 49 программ. Можно ли это сделать за одну? Заранее спасибо!

Мои макросы выглядят так:

Sub Прямоугольник1_Щелчок()
x = 1
Vybor (x) ' Запускается подпрограмма Vybor
End Sub

[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]

[Андрей45]

Для запуска макроса в этом случае удобно использовать не прямоугольники, а ячейки листа.
Двойной щелчок по ячейке - и в определённой ячейке появится соответствующее значение.

А с прямоугольниками никак? Они у меня красивые - перекрашиваются потом в разные цвета. Тем более, что под ними - фон с картинкой.

[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]

Application.Caller возвращает имя автофигуры (прямоугольника), вызвавшей макрос.

Вот что у меня получилось:

[Андрей45]

А можетe написать комментарии к каждой строчке, а то у меня не получается? Мне надо просто - щелкнули - получили номер, присвоили иксу этот номер. Мне не надо перекрашивать - я это в другом месте делаю.
О!!! Спасибо большое! Я догадался! У меня заработало!
Мой макрос:

Sub test()
imya = Application.Caller
x = Mid(imya, 14)
Vybor (x)
End Sub
Всего-то!

[SAS888]

Ели Вы пишете код только для себя, то можно и так. А если для других пользователей, то я бы не рисковал использовать x = Mid(imya, 14), т.к. в разных языковых вариантах Excel количество символов в имени одной и той же автофигуре может быть разным.
Надежнее так:

Код: Выделить всё

x = Split(Application.Caller, " ")(1)