VBA中是否有选择形状事件？

如何解决VBA中是否有选择形状事件？

我有一个包含图片的 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

解决方法

如评论中所写，您可以为单击形状时执行的形状分配（无参数）子。

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

使用 VBA，您将宏的名称写入形状的 OnAction 属性：

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