Excel VBA为形状组内按钮分配宏时触发运行时错误1004求助

问题场景 #

需求是在加载时为工作表中指定形状组内的每个按钮分配宏，但执行oShape.OnAction = "'" & ActiveWorkbook.Name & "'!FolderSelectorButton"语句时触发错误：

运行时错误1004：应用程序定义或对象定义错误

使用的VBA代码如下：

Private Const SideNavName As String = "SideNav"

Public Sub SetSideNavigationOnAllSheets()
    Dim ws As Worksheet
    Dim oShape As Shape
    
    For Each ws In ActiveWorkbook.Sheets
        'check to see if sidenav shape/group exists in sheet
        If Common.ShapeExists(ws, SideNavName) Then
            ' get side nav
            For Each oShape In ws.Shapes(SideNavName).GroupItems
                ' only need the nav buttons not container
                If Left(oShape.Name, 3) = "Nav" Then
                    Debug.Print ws.Name, oShape.Name
                    oShape.TextFrame.Characters.Text = "btn 1" ' pull from DB
                    oShape.OnAction = "'" & ActiveWorkbook.Name & "'!FolderSelectorButton"  '  ERRORS OUT HERE
                End If
            Next
        End If
    Next
End Sub

Public Sub FolderSelectorButton()
    Debug.Print 1
End Sub

错误原因 #

Excel中形状组内的子形状无法单独设置OnAction属性，该属性仅支持直接作用于独立形状或整个形状组，这是导致1004错误的核心原因。此外，若工作簿名称包含空格，原代码的字符串拼接方式也可能引发路径识别问题。

解决方案 #

方案1：取消分组后单独设置宏，再重新分组 #

如果允许修改形状组结构，可先取消分组为每个按钮设置宏，之后重新分组：

Private Const SideNavName As String = "SideNav"

Public Sub SetSideNavigationOnAllSheets()
    Dim ws As Worksheet
    Dim oShape As Shape
    Dim groupedShapes As ShapeRange
    
    For Each ws In ActiveWorkbook.Sheets
        If Common.ShapeExists(ws, SideNavName) Then
            ' 保存组内所有形状并取消分组
            Set groupedShapes = ws.Shapes(SideNavName).GroupItems
            ws.Shapes(SideNavName).Ungroup
            
            ' 为符合条件的按钮设置宏
            For Each oShape In groupedShapes
                If Left(oShape.Name, 3) = "Nav" Then
                    Debug.Print ws.Name, oShape.Name
                    oShape.TextFrame.Characters.Text = "btn 1"
                    ' 用FullName确保路径正确，兼容带空格的工作簿名称
                    oShape.OnAction = "'" & ThisWorkbook.FullName & "'!FolderSelectorButton"
                End If
            Next
            
            ' 重新分组并恢复原名称
            groupedShapes.Group.Name = SideNavName
        End If
    Next
End Sub

Public Sub FolderSelectorButton()
    Debug.Print 1
End Sub

方案2：为整个组设置宏，在宏内判断点击的子形状 #

若不想修改分组结构，可为整个形状组绑定宏，再通过Application.Caller识别点击的子形状：

Private Const SideNavName As String = "SideNav"

Public Sub SetSideNavigationOnAllSheets()
    Dim ws As Worksheet
    Dim groupShape As Shape
    
    For Each ws In ActiveWorkbook.Sheets
        If Common.ShapeExists(ws, SideNavName) Then
            Set groupShape = ws.Shapes(SideNavName)
            ' 为整个形状组绑定宏
            groupShape.OnAction = "'" & ThisWorkbook.FullName & "'!SideNavGroup_Click"
            
            ' 批量更新按钮文本
            For Each oShape In groupShape.GroupItems
                If Left(oShape.Name, 3) = "Nav" Then
                    oShape.TextFrame.Characters.Text = "btn 1"
                End If
            Next
        End If
    Next
End Sub

Public Sub SideNavGroup_Click()
    Dim clickedShape As Shape
    ' 获取点击的子形状
    Set clickedShape = ActiveSheet.Shapes(Application.Caller).GroupItems(Application.Caller)
    
    ' 判断是否为目标按钮，执行对应逻辑
    If Left(clickedShape.Name, 3) = "Nav" Then
        FolderSelectorButton
    End If
End Sub

Public Sub FolderSelectorButton()
    Debug.Print 1
End Sub

额外注意事项 #

• 优先使用ThisWorkbook.FullName代替ActiveWorkbook.Name，避免工作簿未保存或名称带空格时的路径识别错误。
• 确保Common.ShapeExists函数能准确判断形状组是否存在，避免因形状缺失引发额外错误。

内容的提问来源于stack exchange，提问作者skillilea