将现有的受密码保护的工作表作为不受保护的工作表复制到新工作簿不会使新工作表不受保护

时间:2016-01-27 20:51:18

标签: excel vba excel-vba excel-2013

当用户尝试在新工作表中键入数据时,将现有的受密码保护的工作表复制为新工作簿作为不受保护的工作表会出现以下错误。

  

错误:“您尝试更改的单元格或图表位于受保护的工作表上”

在错误消息上单击“确定”。

请注意,此错误只发生一次。单击弹出错误消息上的确定并再次键入,然后excel允许您在单元格中键入数据并保存工作表。

当点击同一电子表格中表单上的按钮时,我们有一个excel(格式.xls)文件,用于创建另一个Excel电子表格。它基本上将一个受密码保护的空白页(模板)复制到新工作簿作为不受保护的工作表。以下代码用于处理excel 2007(使用.xls格式)。我们最近从excel 2007升级到excel 2013,问题就出现了。

Private Sub cmd_Click()
Dim jBook As Workbook
Dim jsheet As Worksheet

CurrentWorkBook = ActiveWorkbook.Name
Workbooks(CurrentWorkBook).Unprotect jWorksheetPassword
'catch all for errors
On Error GoTo ErrEnd  

Dim orginalScreenUpdating As Boolean
orginalScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

If Range("Language").Value = "2" Then
   'French
  Set jsheet = TemplateFR
Else
   'english
   Set jsheet = TemplateEN
End If

jsheet.Visible = xlSheetHidden
'jSheet.Visible = xlSheetVisible

'Delete this line
jsheet.Unprotect jWorksheetPassword

Set jBook = Workbooks.Add(xlWBATWorksheet)
jsheet.Copy After:=jBook.Sheets(1)
jBook.Sheets(2).Visible = xlSheetVisible

Application.DisplayAlerts = False
jBook.Sheets(1).Delete
Application.DisplayAlerts = True

jsheet.Visible = xlSheetVeryHidden

'Delete this line
jBook.Sheets(1).Unprotect jWorksheetPassword
'Delete this line
'jsheet.Protect Password:=jWorksheetPassword

NoErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.ScreenUpdating = orginalScreenUpdating
Unload Me
Exit Sub

ErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox DataTable.Range("MSG4").Value, vbCritical,    DataTable.Range("MSG4TITLE").Value
Unload Me

End Sub

1 个答案:

答案 0 :(得分:0)

以下代码行会激活原始工作簿,并且仅以excel 2013清除了对复制工作表的保护。在Excel 2007上,这会导致原始工作簿被激活并使用户感到困惑,因此会检查2013年。

If Application.Version = "15.0" Then
    Workbooks(CurrentWorkBook).Activate
    'jBook.Activate
End If

这是一个正常工作的黑客。如果有人找到更好的解决方案,请在此处发布。

完整的代码清单如下:

Private Sub cmd_Click()
Dim jBook As Workbook
Dim jsheet As Worksheet

CurrentWorkBook = ActiveWorkbook.Name
Workbooks(CurrentWorkBook).Unprotect jWorksheetPassword
'catch all for errors
On Error GoTo ErrEnd
Dim orginalScreenUpdating As Boolean
orginalScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

If Range("Language").Value = "2" Then
    'French
    Set jsheet = TemplateFR
Else
    'english
    Set jsheet = TemplateEN
End If

jsheet.Visible = xlSheetHidden

Set jBook = Workbooks.Add(xlWBATWorksheet)
jsheet.Copy After:=jBook.Sheets(1)
jBook.Sheets(2).Visible = xlSheetVisible

Application.DisplayAlerts = False
jBook.Sheets(1).Delete
Application.DisplayAlerts = True

If Application.Version = "15.0" Then
    Workbooks(CurrentWorkBook).Activate
    'jBook.Activate
End If

jsheet.Visible = xlSheetVeryHidden

NoErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword, Structure:=True, Windows:=False
Application.ScreenUpdating = orginalScreenUpdating
Unload Me
Exit Sub

ErrEnd:
Workbooks(CurrentWorkBook).Protect Password:=jWorksheetPassword,     Structure:=True, Windows:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox DataTable.Range("MSG4").Value, vbCritical,     DataTable.Range("MSG4TITLE").Value
Unload Me


End Sub