时间戳

首页 > 解决方案 > 如何锁定某些单元格（表格的列）但允许添加行？

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

问题描述

我有一个表格，我锁定了 10 列中的 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

标签： excelvba

解决方案

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

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

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

希望这可以帮助

推荐阅读