REM ***** BASIC ***** Option Explicit Public PWIndex as Integer Function UnprotectSheetsWithPassWord(oSheets as Object, bDoUnProtect as Boolean) Dim i as Integer Dim MaxIndex as Integer Dim iMsgResult as Integer PWIndex = -1 If bDocHasProtectedSheets Then If Not bDoUnprotect Then ' At First query if sheets shall generally be unprotected iMsgResult = Msgbox(sMsgUNPROTECT,36,sMsgDLGTITLE) bDoUnProtect = iMsgResult = 6 End If If bDoUnProtect Then MaxIndex = oSheets.Count-1 For i = 0 To MaxIndex bDocHasProtectedSheets = Not UnprotectSheet(oSheets(i)) If bDocHasProtectedSheets Then ReprotectSheets() Exit For End If Next i If PWIndex = -1 Then ReDim UnProtectList() as String Else ReDim Preserve UnProtectList(PWIndex) as String End If Else Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) End If End If UnProtectSheetsWithPassword = bDocHasProtectedSheets End Function Function UnprotectSheet(oListSheet as Object) Dim ListSheetName as String Dim sStatustext as String Dim i as Integer Dim bOneSheetIsUnprotected as Boolean i = -1 ListSheetName = oListSheet.Name If oListSheet.IsProtected Then oListSheet.Unprotect("") If oListSheet.IsProtected Then ' Sheet is protected by a Password bOneSheetIsUnProtected = UnprotectSheetWithDialog(oListSheet, ListSheetName) UnProtectSheet() = bOneSheetIsUnProtected Else ' The Sheet could be unprotected without a password AddSheettoUnprotectionlist(ListSheetName,"") UnprotectSheet() = True End If Else UnprotectSheet() = True End If End Function Function UnprotectSheetWithDialog(oListSheet as Object, ListSheetName as String) as Boolean Dim PWIsCorrect as Boolean Dim QueryText as String oDocument.CurrentController.SetActiveSheet(oListSheet) QueryText = ReplaceString(sMsgPWPROTECT,"'" & ListSheetName & "'", "%1TableName%1") '"Please insert the password to unprotect the sheet '" & ListSheetName'" Do ExecutePasswordDialog(QueryText) If bCancelProtection Then bCancelProtection = False Msgbox (sMsgSHEETSNOPROTECT, 64, sMsgDLGTITLE) UnprotectSheetWithDialog() = False exit Function End If oListSheet.Unprotect(Password) If oListSheet.IsProtected Then PWIsCorrect = False Msgbox (sMsgWRONGPW, 64, sMsgDLGTITLE) Else ' Sheet could be unprotected AddSheettoUnprotectionlist(ListSheetName,Password) PWIsCorrect = True End If Loop Until PWIsCorrect UnprotectSheetWithDialog() = True End Function Sub ExecutePasswordDialog(QueryText as String) With PasswordModel .Title = QueryText .hlnPassword.Label = sMsgPASSWORD .cmdCancel.Label = sMsgCANCEL .cmdHelp.Label = sHELP .cmdGoOn.Label = sMsgOK .cmdGoOn.DefaultButton = True End With DialogPassword.Execute End Sub Sub ReadPassword() Password = PasswordModel.txtPassword.Text DialogPassword.EndExecute End Sub Sub RejectPassword() bCancelProtection = True DialogPassword.EndExecute End Sub ' Reprotects the previousliy protected sheets ' The passwordinformation is stored in the List 'UnProtectList()' Sub ReprotectSheets() Dim i as Integer Dim oProtectSheet as Object Dim ProtectList() as String Dim SheetName as String Dim SheetPassword as String If PWIndex > -1 Then SetStatusLineText(sStsREPROTECT) For i = 0 To PWIndex ProtectList() = ArrayOutOfString(UnProtectList(i),";") SheetName = ProtectList(0) If Ubound(ProtectList()) > 0 Then SheetPassWord = ProtectList(1) Else SheetPassword = "" End If oProtectSheet = oSheets.GetbyName(SheetName) If Not oProtectSheet.IsProtected Then oProtectSheet.Protect(SheetPassWord) End If Next i SetStatusLineText("") End If PWIndex = -1 ReDim UnProtectList() End Sub ' Add a Sheet to the list of sheets that finally have to be ' unprotected Sub AddSheettoUnprotectionlist(ListSheetName as String, Password as String) Dim MaxIndex as Integer MaxIndex = Ubound(UnProtectList()) PWIndex = PWIndex + 1 If PWIndex > MaxIndex Then ReDim Preserve UnprotectList(MaxIndex + SBRANGEUBOUND) End If UnprotectList(PWIndex) = ListSheetName & ";" & Password End Sub Function CheckSheetProtection(oSheets as Object) as Boolean Dim MaxIndex as Integer Dim i as Integer Dim bProtectedSheets as Boolean bProtectedSheets = False MaxIndex = oSheets.Count-1 For i = 0 To MaxIndex bProtectedSheets = oSheets(i).IsProtected If bProtectedSheets Then CheckSheetProtection() = True Exit Function End If Next i CheckSheetProtection() = False End Function