Как вызвать функцию excel vba, когда я дважды щелкаю вставленное изображение? Прямо сейчас функция запускается Private Sub Workbook_AfterSave(ByVal Success As Boolean).
Я мог найти примеры только при нажатии на ячейку или гиперссылке, но не смог найти ни одного для двойного щелчка по изображению.
Изображения Excel не имеют события двойного щелчка (например, Access). На листе есть Worksheet_BeforeDoubleClick:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
MsgBox ("Application.Caller: " & IIf(IsError(Application.Caller), Err.Description, _
Application.Caller) & vbLf & "Target.Address: " & _
IIf(IsError(Target.Address), Err.Description, Target.Address))
End Sub
Я не уверен, как проверить, было ли изображение двойным щелчком — Application.Caller возвращает ошибку, если выбрана не ячейка.
Вы можете поместить изображение позади ячеек в качестве фонового изображения и действовать при двойном щелчке ячеек над ним.
.
Или, я полагаю, вы могли бы заставить макрос, назначенный изображению, проверять, сколько времени прошло с момента последнего щелчка по нему. В этом примере будет отображаться MsgBox, если изображение щелкнули дважды в течение 400 мс:
Public clickedPic As String
Public lastTimer As Single
Sub Picture2_Click()
clickedPic = Application.Caller
If (Timer - lastTimer) < 0.5 Then
MsgBox "doubleclick"
er
End If
lastTimer = Timer
Debug.Print clickedPic, Now()
End Sub
Вы можете назначить свойство OnAction фигуре, активирующей процедуру после события щелчка.
Пример кода с добавленным прямоугольником
Конечно, вы можете легко изменить это для существующей формы.
Sub AddRectangle()
Dim oSht As Worksheet
Dim oShape As Shape
Set oSht = ThisWorkbook.Worksheets("MySheet")
' only if you want to add a new shape, otherwise refer to Name or item no
Set oShape = oSht.Shapes.AddShape(msoShapeRectangle, 100, 100, 50, 50)
oShape.Name = "MyRectangle"
' OnAction property assignes the specified procedure (e.g. "MyProcedure") to the shape object.
oSht.Shapes("MyRectangle").OnAction = "MyProcedure"
End Sub
Sub MyProcedure()
MsgBox "Shape MyRectangle has been clicked."
End Sub
