工作表未受保护

时间:2013-06-18 13:06:43

标签: excel vba excel-vba

我有以下代码将一个工作表复制到另一个工作表并仅粘贴值但是保护工作表的代码不起作用?我在这做错了什么?

Sub GetQuote()

    Range("AK548").Select
    Selection.Copy
    Range("AK549").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Dim ws As Worksheet
    Dim sDataOutputName As String

    With Application
        .Cursor = xlWait
        .StatusBar = "Saving Quote & Proposal Sheet..."
        .ScreenUpdating = False

         '       Copy specific sheets
         '       *SET THE SHEET NAMES TO COPY BELOW*
         '       Array("Sheet Name", "Another sheet name", "And Another"))
         '       Sheet names go inside quotes, seperated by commas
        On Error GoTo ErrCatcher
        Sheets(Array("Quote & Proposal")).Copy
        On Error GoTo 0

         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
        Next ws
        Cells(1, 1).Select

        sDataOutputName = ThisWorkbook.Path & "\" & ThisWorkbook.Worksheets("Quote Questions").Range("AK545").Value & ".xlsx"

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs sDataOutputName
        ActiveWorkbook.Protect Password:="12345"
        ActiveWorkbook.Close SaveChanges:=False

        .Cursor = xlDefault
        .StatusBar = False
        .ScreenUpdating = True
    End With
    Exit Sub

ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
End Sub

3 个答案:

答案 0 :(得分:2)

您的代码正在显示工作预订,而不是工作表保护。如果要保护工作表,请使用工作表保护:

ws.Protect Password:="12345", DrawingObjects:=True, Contents:=True, Scenarios:=True 
    'ADD AND REMOVE PARAMETERS AS YOU WANT THEM

答案 1 :(得分:2)

您正在保护工作簿并设置密码,在关闭工作簿但未保存更改的下一行代码中。

答案 2 :(得分:0)

我在代码行ActiveSheet.Protect Password:="12345"上面放了ActiveWorkbook.SaveCopyAs sDataOutputName并且它有用了!