Question

我有一个带有VBA代码的工作簿，可以复制模板表，但我希望在复制时保护某些单元格不被编辑。模板表由需要锁定的锁定单元格保护，但某些单元格用于用户输入并应解锁。

我无法将其锁定在复印的纸张中。

Sub MyCopySheet()

    Dim myNewSheetName
    myNewSheetName = InputBox("Enter Today's Date")
    Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName

    Sheets(Sheets.Count - 1).Activate
    Cells.Copy
    Sheets(myNewSheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    Range("F5:F69").ClearContents
    Range("G5:G69").ClearContents
    Range("H5:H69").ClearContents
    Range("I5:I69").ClearContents
    Range("J5:J69").ClearContents
    Range("K5:K69").ClearContents
    Range("Q5:Q59").ClearContents
    Range("O5:O59").ClearContents
    Range("L5:L69").ClearContents
    Range("B23:B27").ClearContents
    Range("B59:B63").ClearContents
    Range("B32:B36").ClearContents
    Range("B78:B94").ClearContents
    Range("C78:C94").ClearContents
    Range("F78:F94").ClearContents
    Range("G78:G94").ClearContents
    Range("J78:J94").ClearContents
    Range("I78:I94").ClearContents
    Range("K78:K94").ClearContents
    Range("L78:L94").ClearContents
    Range("B50:B54").ClearContents
End Sub

Sub lockcells()
    Dim Rng
    Dim MyCell
    Set Rng = Range("A1:Q96")
    For Each MyCell In Rng
        If MyCell.Value = "" Then

        Else: ActiveSheet.Unprotect Password:="password"
            MyCell.Locked = True
            MyCell.FormulaHidden = False
            ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True

        End If
    Next
End Sub

基本上所有Range().ClearContent的单元格都必须解锁，其余单元格必须锁定。

Answer 1

Sub MyCopySheet()

    Dim myNewSheetName
    myNewSheetName = InputBox("Enter Today's Date")
    Worksheets.Add(After:=Worksheets("Home")).Name = myNewSheetName

    Sheets(Sheets.Count - 1).Activate
    Cells.Copy
    Sheets(myNewSheetName).Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    'clear contents
    Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").ClearContents
End Sub

我减少了你的代码以清除内容。以下是从清除内容的范围取消保护单元格的代码

Sub lockcells()
    Dim Rng
    Dim MyCell
    Set Rng = Range("A1:Q96")
    For Each MyCell In Rng
        If MyCell.Value = "" Then

        Else: ActiveSheet.Unprotect Password:="password"
            MyCell.Locked = True
            MyCell.FormulaHidden = False
            ActiveSheet.Protect Password:="password", UserInterFaceOnly:=True
        End If
    Next

    'now we unprotect the range we cleared contents
    Range("P107,B23:B27,B32:B36,B50:B54,B59:B63,B78:C94,F78:G94,I78:L94,O5:O59,Q5:Q59,F5:L69").Locked = False
End Sub

复制工作表并锁定某些单元格以进行编辑

1 个答案: