• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Call password protect failing

Kellis

Member
Hi all,

Hope someone can help been scratching my head all night.

I have a code which calls an unprotect sub and once the code has completed calls the protect sub. I am getting an error on the protect code. I cannot see anything wrong with the sub. If I remove the 'Call ProtectAll' the code works, however I need to protect the sheet again.

The Protect code works when I run the sub directly but not when it is called.

Code:
Sub SheetSave()
    '~~> Change Sheet1 to the relevant sheet
    '~~> This will create a new workbook with the relevant sheet
    
    '~~>DirectoryData file path for new sheet,  TcSaveName named range for New sheet, Tomorrow is day +1 for file name
  
    Dim Directorydata, CSSaveName, MName
    
    
    
    '~~>Unprotect sheets,stop screen flicker and pop up dialogue boxes
    
    Call UnProtectAll
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    
   '~~>Sets Dims
  
    Directorydata = "\\klmc\documents\Historic\"
    MName = ActiveSheet.Name
    CSSaveName = Directorydata & MName & Range("J6").Value & " " & Format(Range("J48").Value, "dd-mm-yyyy") & ".xls"
  
    '~~>Copies new workbook
      
   Dim ws As Worksheet, flg As Boolean
For Each ws In Sheets
    If ws.Visible = -1 Then
        ws.Select Not flg
        flg = True
    End If
Next
ActiveWindow.SelectedSheets.Copy
    
  
        
    '~~> Removes Command buttons
            
    On Error Resume Next
    ActiveSheet.DrawingObjects.Visible = True
    ActiveSheet.DrawingObjects.Delete
    On Error GoTo 0
    
            
    '~~>Locks cells
    
    ActiveSheet.Protect UserInterfaceOnly:=True

    '~~> Save the new workbook
          
    ActiveWorkbook.SaveAs Filename:=CSSaveName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.RunAutoMacros Which:=xlAutoClose
    Application.CommandBars("Stop Recording").Visible = False
    
    ActiveWorkbook.Close
    ThisWorkbook.Save
  
    
    Call ProtectAll
    
    Application.ScreenUpdating = True
    
    
End Sub

Thanks in advance
 
Back
Top