时间戳

首页 > 解决方案 > 调用 Sub 导致 Sub undefined 错误

vba - 调用 Sub 导致 Sub undefined 错误

问题描述

我正在尝试找到一种方法来让我的表格自动扩展，同时防止用户使用公式编辑列。鉴于这是一种很常见的情况，看起来它应该很简单，没有花哨的编码，但我离题了......

我在网上找到了以下代码（向作者道歉，因为我不记得在哪里）：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

    If Sheets("Instructions").Range("autoExpand") Like "Disabled" Then Exit Sub

    Dim Tbl As ListObject, Off As Integer, ExitCode As Label
    Dim TblFirstRow As Long, TblFirstColumn As Integer
    Dim FirstRowAllowed As Long

    On Error GoTo ExitCode

    Off = 0: If Target.Row > 1 Then Off = -1
    Set Tbl = ActiveSheet.ListObjects(1)
    TblFirstRow = Tbl.HeaderRowRange.Row
    TblFirstColumn = Tbl.HeaderRowRange.Cells(1, 1).Column
    OpenClipboard 0
    FirstRowAllowed = TblFirstRow

    If Target.Row >= FirstRowAllowed And Target.Row <= Tbl.ListRows.Count + TblFirstRow + 1 And _
        Target.Column <= Tbl.ListColumns.Count + TblFirstColumn And _
        Target.Cells.Offset(Off, 0).Locked = False Then
        Unprotect
        CloseClipboard
    Else
        GoTo ExitCode
    End If

    Exit Sub

    ExitCode:
        Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                False, UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                AllowFormattingRows:=True, AllowInsertingRows:=True, AllowSorting:=True, _
                AllowFiltering:=True, AllowUsingPivotTables:=True
         CloseClipboard

End Sub

该代码效果很好，但我想在同一个工作簿中的多个工作表上使用它，所以我想也许我可以这样做：

在工作表中：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call table_expand
End Sub

在模块中：

Sub table_expand()

(pasted code from within the Sub above)

End Sub

但是，这不起作用-我得到了

“未定义子”

错误。经过一些谷歌搜索后，问题似乎与缺少或多余的括号有关，但我没有得到任何工作。

我暂时可以将代码粘贴到所有工作表中，但由于我有大约十个，基本上我只是想把它弄干一点......

...我应该认为这是可能的？我确信很明显，我对 VBA 的经验几乎为零，非常感谢您的帮助。

标签： vbaexcel

解决方案

我猜您没有将相关信息传递Target给您的常规宏。所以它不知道该做什么。

像这样的东西：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    myMacro Target
End Sub

在常规模块中：

Sub myMacro(Target As Range)
    MsgBox Target.Worksheet.Name & vbLf & Target.Address

End Sub

Target.Sheet在常规宏中，如果您引用发生事件的工作表，则需要将对工作表的引用更改为或类似的内容。

请注意，在 VBA 中，Call不是必需的。

此外，正如我在阅读@chrisneilsen 的评论后意识到的那样，您可以使用 Workbook 事件代码，而不是将您的事件代码放在每个工作表上。然后你只需要输入一次。例如：

工作簿代码：

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
    Call myMacro(sh, Target)
End Sub

常规模块：

Sub myMacro(sh As Worksheet, Target As Range)
    Dim Tbl As ListObject
    Set Tbl = sh.ListObjects(1)
    Stop

End Sub

或者您可以将所有宏代码放入工作簿代码中；维护您希望发生这种情况的工作表列表并添加测试。

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub

    If Sheets("Instructions").Range("autoExpand") Like "Disabled" Then Exit Sub

    Dim Tbl As ListObject, Off As Integer, ExitCode As Label
    Dim TblFirstRow As Long, TblFirstColumn As Integer
    Dim FirstRowAllowed As Long

    On Error GoTo ExitCode

    Off = 0: If Target.Row > 1 Then Off = -1
    Set Tbl = sh.ListObjects(1)
    TblFirstRow = Tbl.HeaderRowRange.Row
    TblFirstColumn = Tbl.HeaderRowRange.Cells(1, 1).Column
    OpenClipboard 0
    FirstRowAllowed = TblFirstRow

    If Target.Row >= FirstRowAllowed And Target.Row <= Tbl.ListRows.Count + TblFirstRow + 1 And _
        Target.Column <= Tbl.ListColumns.Count + TblFirstColumn And _
        Target.Cells.Offset(Off, 0).Locked = False Then
        Unprotect
       CloseClipboard
    Else
        GoTo ExitCode
    End If

    Exit Sub

ExitCode:
        Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                False, UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                AllowFormattingRows:=True, AllowInsertingRows:=True, AllowSorting:=True, _
                AllowFiltering:=True, AllowUsingPivotTables:=True
         CloseClipboard
End Sub

您的代码在我的系统上运行时会返回错误，因此我假设您的环境不同，因为您在工作表上写道它运行正常。

尤其是：

  • OpenClipboard没有定义
  • CloseClipboard没有定义

并且您将希望Worksheet.Protect对该活动使用该方法。

推荐阅读