Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.EnableCancelKey = xlDisabled
On Error Resume Next
ThisWorkbook.Activate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = False
If Worksheets(" Sheet1").Range("NUM").Value < 7 Then
Application.DisplayAlerts = False
ActiveWindow.Visible = False
ThisWorkbook.Close
Exit Sub
End If
ActiveWindow.Visible = True
Application.ScreenUpdating = False
ThisWorkbook.Unprotect Password:=" 12345 "
With Sheets(" Sheet1")
.Activate
.Range("HN32").Calculate
.Range("HN33").Calculate
Range("A730").Select
End With
If Worksheets(" Sheet1").Range("NA").Value = 0 Then
Application.ScreenUpdating = False
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.StatusBar = StatusBarMsg
.EnableCancelKey = xlErrorHandler
End With
For Each ThisSheet In ThisWorkbook.Sheets
ThisSheet.Visible = True
Next ThisSheet
Sheets("Sheet").Visible = False
Sheets(2).Select
For N = 1 To 74
ActiveWindow.SelectedSheets.Delete
Next N
For N = 1 To 16
Sheets("Sheet").Copy After:=Sheets(1)
Next N
ThisWorkbook.Protect Password:=12345
Dim Temp$
Temp = Application.InputBox("'" & ActiveWorkbook.Name & "'" & " is protected. Password:", "Password")
If Temp = "" Then
GoTo Finally
End If
If Temp = "abcde" Then
GoTo Finally
Else
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = ("The password you supplied is not correct. Verify that the CAPSLOCK key is off and be sure to use the correct capitalization.")
Style = vbOKOnly + vbExclamation + vbDefaultButton1
Title = "Microsoft Office Excel"
Help = "DEMO.HLP"
Ctxt = 1000
Response = Msgbox(Msg, Style, Title, Help, Ctxt)
End If
Finally:
Application.ScreenUpdating = False
Dim Path$
Application.DisplayAlerts = False
i = ActiveWorkbook.Path & "/" & ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:=i, Password:=TxtFLFilter, CreateBackup:=False
ActiveWorkbook.ProtectSharing
ActiveWindow.Visible = False
ThisWorkbook.Close
GoTo Finally
Else
Application.ScreenUpdating = False
ActiveWindow.TabRatio = 0.92
ThisWorkbook.Unprotect Password:=12345
Application.ScreenUpdating = False
If Worksheets(3).Range("H76").Value < 0.1 Then
Dim Temp$
Temp = Application.InputBox("'" & ActiveWorkbook.Name & "'" & " is protected. Password:", "Password")
If Temp = "" Then
Exit Sub
End If
If Temp = "0000" Then
For N = 4 To 74
Sheets(N).Activate
ActiveSheet.Unprotect Password:=12345
c = Sheets(3).Range("W60").Value
r = Sheets(3).Range("X60").Value
Range(Cells(c, 5), Cells(r, 26)).Locked = False
Next N
Else
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = ("The password you supplied is not correct. Verify that the CAPSLOCK key is off and be sure to use the correct capitalization.")
Style = vbOKOnly + vbExclamation + vbDefaultButton1
Title = "Microsoft Office Excel"
Help = "DEMO.HLP"
Ctxt = 1000
Response = Msgbox(Msg, Style, Title, Help, Ctxt)
End If
End If
N = 0
For Each Sheet In Sheets()
N = N + 1
Sheets(N).Activate
Sheets(N).Visible = True
ActiveSheet.Unprotect Password:=12345
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=False, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowSorting:=True, Password:=12345
ActiveSheet.EnableSelection = xlNoRestrictions
With ActiveWindow
.DisplayHeadings = False
.DisplayOutline = False
End With
Next
Application.ScreenUpdating = False
With Sheets("Sheet87")
.Activate
.Unprotect Password:=12345
Range("IPMT").Copy
Range("ps").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
.Protect Password:=12345
Range("A730").Select
End With
With ActiveWindow
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
.DisplayWorkbookTabs = True
End With
ThisWorkbook.Sheets(" Sheet1").Visible = xlVeryHidden
ThisWorkbook.Sheets("Sheet87").Visible = xlVeryHidden
ThisWorkbook.Sheets("Sheet86").Visible = xlVeryHidden
Sheets("Sheet").Visible = False
ThisWorkbook.Protect Password:=12345
End If
Application.ScreenUpdating = False
With Sheets("Sheet0")
.Activate
Range("B1").ClearContents
End With
Sheets(3).Select
Application.CommandBars("File").Controls(5).Visible = False
Application.CommandBars("File").Controls(6).Visible = False
Application.CommandBars("View").Controls(4).Visible = False
Application.CommandBars("Tools").Controls(13).Visible = False
Application.CommandBars("Tools").Controls(14).Visible = False
Application.CommandBars("Tools").Controls(15).Visible = False
Application.CommandBars("Tools").Controls(17).Visible = False
ActiveWindow.DisplayWorkbookTabs = True
Application.Calculation = xlAutomatic
ActiveWindow.WindowState = xlMaximized
Application.EnableEvents = True
Application.ScreenUpdating = True
Finally:
Application.StatusBar = ""
End Sub
A2 =UniVba(A1))
