Unprotect sheet when Saving As

deutz

New member
Joined
May 28, 2012
Messages
27
Reaction score
0
Points
0
Hi and thanks in advance,

I have a workbook with a protected sheet. I run some code that Saves As into a new workbook removing all formulas but leaving the values and formats in tact. I would like to leave the sheet in the original wkb protected but remove the protection from the sheet in the Saved As wkb? Not sure how or where to slot in the unprotect code?

Here is my code thus far:


Code:
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Sub ExportWorkbook()[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Dim varFileName As Variant[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Dim strRestrictedName As String[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   On Error GoTo Err_Handler[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   strRestrictedName = ActiveWorkbook.Name[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.EnableEvents = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   varFileName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\", fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   If varFileName <> False Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]      If UCase$(varFileName) <> UCase$(strRestrictedName) Then[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          ActiveWorkbook.SaveAs varFileName[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          Application.EnableEvents = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          FormulasToValues (varFileName)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          ActiveWorkbook.Save[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          MsgBox "Done"[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]      Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]          MsgBox "Invalid File Name", vbCritical, "Stop"[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]      End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       ' Cancelled Save As dialog[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   End If[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.EnableEvents = True[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]Err_Exit:[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.EnableEvents = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Exit Sub[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]Err_Handler:[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Select Case Err[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       Case 1004 ' Cancelled overwrite of existing file in Save As msgbox[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           ' do nothing[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       Case Else[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           MsgBox Err & " " & Err.Description[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   End Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   GoTo Err_Exit[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]End Sub[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]Sub FormulasToValues(WkbName As String)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Dim ws As Worksheet[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Dim wkb As Workbook[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.ScreenUpdating = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.Calculation = xlCalculationManual[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Set wkb = Application.Workbooks(WkbName)[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman] For Each ws In wkb.Worksheets[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       With ws[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           .Activate[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           On Error Resume Next[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           .ShowAllData[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           .AutoFilterMode = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           Worksheets(ws).ShowAllData = True[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           On Error GoTo 0[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]           .Cells.Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]            Selection.Copy[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]            Selection.PasteSpecial xlPasteValuesAndNumberFormats[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]            Selection.PasteSpecial xlFormats[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]            Selection.PasteSpecial xlPasteColumnWidths[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       End With[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       ws.Range("A1").Select[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]       Application.CutCopyMode = False[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Next[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Sheets(1).Activate[/FONT][/COLOR][/SIZE]

[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.Calculation = xlCalculationAutomatic[/FONT][/COLOR][/SIZE]
[SIZE=3][COLOR=#000000][FONT=Times New Roman]   Application.ScreenUpdating = True[/FONT][/COLOR][/SIZE]
[FONT=Times New Roman][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
 
In your FormulasToValues routine, add the following just below the .Activate line:
Code:
.Unprotect "Password"

Where the word password is replaced with the actual password you use.

HTH,
 
Thanks Ken,

That removed the sheet protection as required.

One other thing though ... after calling sub FormulaToValues, I have the line ... ActiveWorkbook.Save ... which is supposed to save the changes, including the removed sheet protection. But if after running the code I then close the Saved As wkb manually, I am prompted via a message box to Save any changes and if I chose No and open the wkb again the sheet is protected as before. Is there some way to save the workbook via VBA after unprotecting it so that if the user closes the wkb and selects No when prompted then the changes to the protection will still be saved? I also tried putting the line ... wkb.Save ... as the very last line in sub FormulaToValues but that also did not work.
 
Iirc, the issue is that you've got msgbox lines that are being called after the save and that marks the workbook as "Dirty" (changed). Try inserting the following right before the Err_Exit line of your Export Workbook routine:
Code:
ActiveWorkbook.Saved = True
Exit Sub

I think that should take care of it, and also ensures that enabling events won't also trigger it as dirty again. (Can't remember if this does or not.)
 
Did as you suggested Ken but although I am not prompted to save changes when I close the wkb manually, the protection is still there when I re-open the wkb.

The only other code I run when the wkb shuts down is to hide/delete the custom menu bar ... so I don't know if that is the problem or something else entirely ...

Code:
Private Sub Workbook_Deactivate()
   Run "HideMyToolbar"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim ans As Integer
    Dim msg As String
    
    If Not Me.Saved Then
        msg = "Do you want to save the changes you made to "
        msg = msg & Me.Name & "?"
        ans = MsgBox(msg, vbQuestion + vbYesNoCancel)
        Select Case ans
            Case vbYes
                Me.Save
            Case vbNo
                Me.Saved = True
            Case vbCancel
                Cancel = True
                Exit Sub
        End Select
    End If
    On Error Resume Next
    Application.CommandBars("Profile Testing WIN").Delete
End Sub
 
Hi Ken,

I commented out the hide/delete custom menu bar code and tried to export but got the same result so it must be something else.
 
Thanks for you help Ken. As it turns out, I'm an idiot who forgot that I had code in the wkb open event that protects the wkb to set UserInterfaceOnly:=True

So thanks again for your professional advice and I hope I didn't waste too much of your time.
 
Back
Top