Как правильно назначить макрос фигуре?
У меня есть книга под названием BOOK1, в которой есть лист TEST и фигура TESTSHAPE. В коде vba для листа у меня есть следующий код, который позволяет пользователю щелкать фигуру и переключаться между цветами.
Dim sh As Shape
Set sh = Me.Shapes(Application.Caller)
'If red go black
If sh.Fill.ForeColor.RGB = RGB(255, 1, 2) Then
sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
sh.Fill.Transparency = 0.45
sh.Line.ForeColor.RGB = RGB(198, 0, 241)
sh.Line.Visible = False
'If black go white
ElseIf sh.Fill.ForeColor.RGB = RGB(0, 0, 0) Then
sh.Fill.ForeColor.RGB = RGB(255, 255, 255)
sh.Fill.Transparency = 0.95
sh.Line.ForeColor.RGB = RGB(198, 0, 241)
sh.Line.Visible = False
'If white go red
ElseIf sh.Fill.ForeColor.RGB = RGB(255, 255, 255) Then
sh.Fill.ForeColor.RGB = RGB(255, 0, 0)
sh.Fill.Transparency = 0.55
sh.Line.ForeColor.RGB = RGB(198, 0, 241)
sh.Line.Visible = False
ElseIf sh.Fill.ForeColor.RGB = RGB(255, 255, 255) Then
sh.Fill.ForeColor.RGB = RGB(0, 200, 20)
sh.Fill.Transparency = 0.55
sh.Line.ForeColor.RGB = RGB(198, 0, 241)
sh.Line.Visible = False
Else
sh.Fill.ForeColor.RGB = RGB(255, 255, 255)
sh.Fill.Transparency = 0.89
sh.Line.ForeColor.RGB = RGB(198, 0, 241)
sh.Line.Visible = False
End If
End Sub
Это работает нормально, но если я скопирую лист в новую книгу, например, КНИГУ2, макрос, назначенный фигуре, перестанет работать, поскольку он все еще связан с листом в первой книге. Тогда мне придется вручную переназначить макрос
Когда я переименовываю макрос в имя листа, ссылка на макрос для фигуры становится TEST.One_Click, что имеет смысл, но после копирования листа в BOOK2 ссылка становится !BOOK1.TEST.One_Click, что, очевидно, не работает в BOOK2.
Как сделать так, чтобы он перестал ссылаться на книгу и оставался только на листе?
Есть ли способ полностью разместить макрос на листе, чтобы его можно было скопировать в другие книги и при этом работать без необходимости работы пользователя с макросами?
Ответы 1
Возможно, попробуйте добавить это в модуль кода листа, где находится Tester:
Private Sub Worksheet_Activate()
Dim shp As Shape, arr, el
'list of macros to re-link
arr = Array("Tester", "DoSomething", "LastOne")
For Each shp In Me.Shapes
Debug.Print shp.OnAction
For Each el In arr
If InStr(shp.OnAction, el) > 0 Then
shp.OnAction = Me.CodeName & "." & el
Exit For 'stop checking this shape
End If
Next el
Next shp
End Sub
Sub Tester()
Debug.Print "Tester"
End Sub
Sub DoSomething()
Debug.Print "DoSomething"
End Sub
Sub LastOne()
Debug.Print "LastOne"
End Sub
Он переназначит любые фигуры, OnAction которых указывает на один из макросов, перечисленных в arr.
Альтернативно вы можете просто проверить любую фигуру на наличие OnAction и заменить первую часть:
Private Sub Worksheet_Activate()
Dim shp As Shape, a, arr
For Each shp In Me.Shapes
a = shp.OnAction
If Len(a) > 0 Then
arr = Split(a, ".")
shp.OnAction = Me.CodeName & "." & arr(UBound(arr))
End If
Next shp
End Sub
Привет! Спасибо, все сработало отлично. Как мне изменить его, чтобы он назначал определенные фигуры одному макросу, а определенные формы другому? Я подумывал добавить if внутри вашего кода, чтобы проверять наличие определенных имен фигур в массиве?
Вам нужно только переназначить существующие ссылки? Если проблема заключалась в копировании листа, я предполагаю, что все фигуры уже связаны?
Да, фигуры уже связаны. Но если у меня есть два типа фигур с разными макросами, я хочу, чтобы они могли повторно связать оба.
Второй пример выше повторно свяжет любую фигуру, у которой уже есть ссылка.