Question

我试图找到一种方法来允许我的表自动扩展，同时还阻止用户使用公式编辑列。似乎它没有花哨的编码应该是非常简单的，因为它是一个非常常见的情况，但我离题...

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

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

IN MODULE：

Sub table_expand()

(pasted code from within the Sub above)

End Sub

然而，这不起作用 - 我得到了

＆＃34; Sub未定义＆＃34;

错误。经过一些谷歌搜索似乎问题与丢失或额外的括号有关，但我没有得到任何工作。

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

...我认为可能吗？我很明显很明显我对VBA几乎没有经验，所以非常感谢你的帮助。

Answer 1

我猜你没有将相关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方法。

调用Sub导致Sub undefined错误

1 个答案: