Unprotect sheet when Saving As

[deutz]

Hi and thanks in advance,

I have a workbook with a protected sheet. I run some code that Saves A
into a new workbook and then removes all formulas leaving the values an
formats in tact. I would like to leave the sheet in the original wk
protected but remove the protection from the sheet in the Saved As wk
as part of this process? Not sure how or where to slot in the unprotec
code?

Here is my code thus far:

Code
-------------------

Sub ExportWorkbook()
Dim varFileName As Variant
Dim strRestrictedName As String

On Error GoTo Err_Handler

strRestrictedName = ActiveWorkbook.Name

Application.EnableEvents = False
varFileName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\", fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")
varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)

If varFileName <> False Then
If UCase$(varFileName) <> UCase$(strRestrictedName) Then
ActiveWorkbook.SaveAs varFileName
Application.EnableEvents = True
FormulasToValues (varFileName)
ActiveWorkbook.Save
MsgBox "Done"
Else
MsgBox "Invalid File Name", vbCritical, "Stop"
End If
Else
' Cancelled Save As dialog
End If
Application.EnableEvents = True

Err_Exit:
Application.EnableEvents = True
Exit Sub
Err_Handler:
Select Case Err
Case 1004 ' Cancelled overwrite of existing file in Save As msgbox
' do nothing
Case Else
MsgBox Err & " " & Err.Description
End Select
GoTo Err_Exit
End Sub

Sub FormulasToValues(WkbName As String)
Dim ws As Worksheet
Dim wkb As Workbook

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set wkb = Application.Workbooks(WkbName)
For Each ws In wkb.Worksheets
With ws
.Activate
On Error Resume Next
.ShowAllData
.AutoFilterMode = False
Worksheets(ws).ShowAllData = True
On Error GoTo 0
.Cells.Select
Selection.Copy
Selection.PasteSpecial xlPasteValuesAndNumberFormats
Selection.PasteSpecial xlFormats
Selection.PasteSpecial xlPasteColumnWidths
End With
ws.Range("A1").Select
Application.CutCopyMode = False
Next
Sheets(1).Activate

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Don Guillett]

Hi and thanks in advance,



I have a workbook with a protected sheet. I run some code that Saves As

into a new workbook and then removes all formulas 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

as part of this process? Not sure how or where to slot in the unprotect

code?



Here is my code thus far:



Code:

--------------------



Sub ExportWorkbook()

Dim varFileName As Variant

Dim strRestrictedName As String



On Error GoTo Err_Handler



strRestrictedName = ActiveWorkbook.Name



Application.EnableEvents = False

varFileName = Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\", fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")

varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)



If varFileName <> False Then

If UCase$(varFileName) <> UCase$(strRestrictedName) Then

ActiveWorkbook.SaveAs varFileName

Application.EnableEvents = True

FormulasToValues (varFileName)

ActiveWorkbook.Save

MsgBox "Done"

Else

MsgBox "Invalid File Name", vbCritical, "Stop"

End If

Else

' Cancelled Save As dialog

End If

Application.EnableEvents = True



Err_Exit:

Application.EnableEvents = True

Exit Sub

Err_Handler:

Select Case Err

Case 1004 ' Cancelled overwrite of existing file in Save As msgbox

' do nothing

Case Else

MsgBox Err & " " & Err.Description

End Select

GoTo Err_Exit

End Sub



Sub FormulasToValues(WkbName As String)

Dim ws As Worksheet

Dim wkb As Workbook



Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual



Set wkb = Application.Workbooks(WkbName)

For Each ws In wkb.Worksheets

With ws

.Activate

On Error Resume Next

.ShowAllData

.AutoFilterMode = False

Worksheets(ws).ShowAllData = True

On Error GoTo 0

.Cells.Select

Selection.Copy

Selection.PasteSpecial xlPasteValuesAndNumberFormats

Selection.PasteSpecial xlFormats

Selection.PasteSpecial xlPasteColumnWidths

End With

ws.Range("A1").Select

Application.CutCopyMode = False

Next

Sheets(1).Activate



Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

I didn't look at this in detail but it appears you can make this easier.
In the original, unprotect>
for each sh in this workbook.worksheets
sh.usedrange.value=sh.usedrange.value
next sh

then saveas and close

 

[deutz]

;1606686']On Tuesday, October 23, 2012 10:19:43 PM UTC-5, deutz wrote:-

Hi and thanks in advance,



I have a workbook with a protected sheet. I run some code that Save As

into a new workbook and then removes all formulas leaving the value 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 A wkb

as part of this process? Not sure how or where to slot in th unprotect

code?



Here is my code thus far:



Code:

--------------------



Sub ExportWorkbook()

Dim varFileName As Variant

Dim strRestrictedName As String



On Error GoTo Err_Handler



strRestrictedName = ActiveWorkbook.Name



Application.EnableEvents = False

varFileName

Application.GetSaveAsFilename(InitialFileName:=ThisWorkbook.Path & "\"
fileFilter:="Microsoft Office Excel Workbook (*.xls), *.xls")

varFileName = Mid$(varFileName, InStrRev(varFileName, "\") + 1)



If varFileName <> False Then

If UCase$(varFileName) <> UCase$(strRestrictedName) Then

ActiveWorkbook.SaveAs varFileName

Application.EnableEvents = True

FormulasToValues (varFileName)

ActiveWorkbook.Save

MsgBox "Done"

Else

MsgBox "Invalid File Name", vbCritical, "Stop"

End If

Else

' Cancelled Save As dialog

End If

Application.EnableEvents = True



Err_Exit:

Application.EnableEvents = True

Exit Sub

Err_Handler:

Select Case Err

Case 1004 ' Cancelled overwrite of existing file in Save As msgbox

' do nothing

Case Else

MsgBox Err & " " & Err.Description

End Select

GoTo Err_Exit

End Sub



Sub FormulasToValues(WkbName As String)

Dim ws As Worksheet

Dim wkb As Workbook



Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual



Set wkb = Application.Workbooks(WkbName)

For Each ws In wkb.Worksheets

With ws

.Activate

On Error Resume Next

.ShowAllData

.AutoFilterMode = False

Worksheets(ws).ShowAllData = True

On Error GoTo 0

.Cells.Select

Selection.Copy

Selection.PasteSpecial xlPasteValuesAndNumberFormats

Selection.PasteSpecial xlFormats

Selection.PasteSpecial xlPasteColumnWidths

End With

ws.Range("A1").Select

Application.CutCopyMode = False

Next

Sheets(1).Activate



Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

I didn't look at this in detail but it appears you can make thi
easier.
In the original, unprotect>
for each sh in this workbook.worksheets
sh.usedrange.value=sh.usedrange.value
next sh

then saveas and close

Thanks, that simplifies things enormously. Also, as it turns out I ha
some code that protected the wkb in the Wkb Open event so I was a victi
of my own stupidity