VBA中有选择形状事件吗？

Question

我有包含图片的 Excel 项目。我有包含 ImageBox 的用户表单。此表单使用选择更改事件根据行号动态显示图片。

当单元格选择更改时触发此事件。但我想通过单击形状来触发此事件。有什么解决办法吗？

请看图片。

这些是单元格选择更改事件的代码。

Private Sub App_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Application.ScreenUpdating = False
Dim Pic As Shape
  For Each Pic In ActiveSheet.Shapes
    If Pic.TopLeftCell.Row = ActiveCell.Row Then
      If Pic.Type = msoPicture Then
         Pic.Select
    
         Dim sheetName As String, MyPicture As String, strPicPath As String
         sheetName = ActiveSheet.Name
         MyPicture = Selection.Name

         strPicPath = SavedPictureTo(MyPicture)' This function save image
         Load ImageViever      'ImageViewer is UserForm name

          With ImageViever
          .Image1.Picture = LoadPicture(strPicPath)
          .Show vbModeless
         End With
        Exit For
      End If
    End If
  Next

Application.ScreenUpdating = True
End Sub

Answer 1

正如注释中所写，您可以将（无参数）Sub 分配给单击形状时执行的形状。

在 Excel 中，您可以通过右键单击形状并选择“分配宏”来分配宏。

使用 VBA，您可以将宏的名称写入OnAction形状的 -property：

Dim sh As Shape
For Each sh In ActiveSheet.Shapes  ' <-- Select the sheet(s) you need
    sh.OnAction = "HelloWorld"     ' <-- Change this to the name of your event procedure
Next

如果您想知道单击了哪个形状，可以使用该Application.Caller属性。当通过单击形状调用宏时，它包含该形状的名称。

Sub helloWorld()
    Dim sh As Shape
    On Error Resume Next
    Set sh = ActiveSheet.Shapes(Application.Caller)
    On Error GoTo 0
    
    If sh Is Nothing Then
        MsgBox "I was not called by clicking on a shape"
    Else
        MsgBox "Someone clicked on " & sh.Name
    End If
End Sub