Question

我有一个表，其中锁定了10列中的5列，因此它们的公式是隐藏的且不可编辑。该代码在隐藏和编辑方面做得很好。

我希望添加行。

当我右键单击工作表本身上表格中的单元格时，尽管“ AllowInsertingRows：= True”是我保护的一部分，但插入新表格行的选项仍显示为灰色。
当我右键单击行号所在页面的左侧时，它会弹出“您要更改的单元格或图表在受保护的工作表上”错误5次（我假设对于5个锁定列中的每一个都进行一次），然后向表中添加一行，但是通常不会插入到新表行中的所需公式不存在。

我正在尝试这样做，以便用户无法“弄乱桌子”。

我正在使用的桌子的照片，因为我不知道一种更好的方式为您说明它

Sub lockDesiredCellsInWeeklyTables()

Dim shtName As String
Dim tblName As String
Dim tbl As ListObject

dateName = "[Date]"
timeName = "[Time]"
phone1Name = "[Phone '#1]"
phone2Name = "[Phone '#2]"
phone3Name = "[Phone '#3]"

ActiveSheet.Cells.Locked = False
    Set tbl = ActiveSheet.ListObjects("april1")
    ' Locks the Date column
    Range(tbl & dateName).Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ' Locks the Time column
    Range(tbl & timeName).Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ' Locks the Phone #1 column
    Range(tbl & phone1Name).Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ' Locks the Phone #2 column
    Range(tbl & phone2Name).Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ' Locks the Phone #3 column
    Range(tbl & phone3Name).Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveSheet.Protect Password:="1234", DrawingObjects:=False, _
                    Contents:=True, Scenarios:=False, _
                    AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                    AllowFormattingRows:=True, AllowInsertingColumns:=False, _
                    AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
                    AllowDeletingColumns:=False, AllowDeletingRows:=True, _
                    AllowSorting:=True, AllowFiltering:=True, _
                    AllowUsingPivotTables:=True
End Sub

Answer 1

您可以做的是将所需的代码添加到右键菜单-而不是按钮上

首先将这两个例程添加到您现有的代码中-将它们添加到右键菜单中或从右键菜单中删除

Sub Add2RCMenu()
   '
   ' This will add items to the RightClick Menu
   ' Each will be Tagged with the Text "RCM" for ease of removal
   '
   Dim RClickMenu As CommandBar, dPos As Long
   Dim MyButn As CommandBarButton, LastButn As CommandBarButton

   ' Delete ALL pre-existing RCM controls first to avoid Duplicates.
     CleanRCMenu "RCM"
   ' Done

   Set RClickMenu = Application.CommandBars("Cell")
   dPos = RClickMenu.Controls.Count

   dPos = dPos + 1
   Set MyButn = RClickMenu.Controls.Add(Type:=msoControlButton, before:=dPos)
       MyButn.OnAction = "'" & ThisWorkbook.Name & "'!DoNothin"
       'MyButn.FaceId = 39
       MyButn.Caption = "*** Special Additions ***"
       MyButn.Tag = "RCM"
       MyButn.BeginGroup = True

   dPos = dPos + 1
   Set LastButn = RClickMenu.Controls.Add(Type:=msoControlButton, before:=dPos)
       LastButn.OnAction = "'" & ThisWorkbook.Name & "'!RCMAddNewRow"
       LastButn.FaceId = 18
       LastButn.Caption = "NEW Row"
       LastButn.Tag = "RCM"
       LastButn.BeginGroup = True
End Sub

Sub CleanRCMenu(GivnTag As String)
    ' Removes Items from the Right-Click Menu
    ' Items marked with a text tag

    Dim ContextMenu As CommandBar, xCtrl As CommandBarControl

    Set ContextMenu = Application.CommandBars("Cell")
    For Each xCtrl In ContextMenu.Controls
        If GivnTag <> "" And xCtrl.Tag = GivnTag Then
            xCtrl.Delete
        End If
    Next xCtrl
End Sub

要适应这些菜单添加，您需要2个新的Subs-如下所示（为空，您可以添加要放在按钮上的代码

Sub DoNothin()
   ' Self Explanatory - Does Nothing
End Sub

Sub RCMAddNewRow()
   ' Put whatever code you want here instead of on a button click
End Sub

希望这会有所帮助

如何锁定某些单元格（表的列），但允许添加行？

1 个答案: