请高手瞧瞧、看看，我这个代码运行很慢，能否帮我优化？谢谢！

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.OnKey "{Esc}", "录入数据"
Application.OnKey "^{m}", "用户窗"
Application.OnKey "^{o}", "核对电子支付数据"
If Day(Date) = 10 Or Day(Date) = 20 Then Application.OnTime Now + TimeValue("00:02:00"), "ts" '提示打印旬报报表
If Day(Date) = 1 And Time > TimeValue("10:00:00") And Sheet8.[a39] < 1 Then
Worksheets("录入").Unprotect Password:="8812968"
Sheet8.Range("c5:o35,q5:y35").ClearContents '删除上月数
Sheet8.[a39] = [a39] + 1
End If
If Sheet16.Range("h3") <> "" And Time > TimeValue("10:00:00") Then
Sheet16.Visible = -1 '显示财收四
Sheet8.Shapes("Button 751").Visible = True '显示按钮
Else
Sheet16.Visible = 2 '隐藏财收四
Sheet8.Shapes("Button 751").Visible = False '隐藏按钮
End If
Worksheets("定额财收4").Unprotect Password:="6123456"
If Time < TimeValue("10:30:00") Or Time > TimeValue("17:00:00") Then
Sheet16.Range("a6:h16,a27:h37").Font.ColorIndex = 2 '12:00前为白色
Worksheets("定额财收4").Protect Password:="6123456"
End If
Sheets("录入").Activate '默认打开工作表
For i = 5 To 35
If Range("a" & i) = Date Then Sheet8.Range("c" & i).Select '鼠标定位单元格
Next i
Sheet16.Unprotect Password:=6123456
ActiveSheet.ResetAllPageBreaks
Sheet16.Cells.Locked = True
Sheet16.Protect Password:="6123456"
Dim a, t As Integer
For a = 5 To 35
If Sheet8.Range("a" & a) = Date Then
ActiveSheet.Unprotect Password:=8812968
ActiveSheet.ResetAllPageBreaks
Sheet8.Range("c" & a & ":y" & a).Locked = False '撤销锁定单元格
ActiveSheet.Protect Password:=8812968
End If
Next
For t = 5 To 35
If Sheet8.Range("a" & t) <> Date Or Time > TimeValue("15:00:00") Then
ActiveSheet.Unprotect Password:=8812968
ActiveSheet.ResetAllPageBreaks
Range("c" & t & ":y" & t).Locked = True '锁定单元格
ActiveSheet.Protect Password:=8812968
End If
Next
ActiveSheet.Unprotect Password:=8812968
Dim s As Integer
For s = 5 To 35
With Sheet8
If .Cells(s, 1) = Date And Not .Range(Replace("d ,h ,i ,l ,o ,s ,u ", " ", s)).Find("*") Is Nothing Or .Cells(s, 26) = "" Then
If MsgBox("检测到错误！请选择“是”，否则今日缴款合计错误！", vbYesNo) = vbYes Then
Application.Run "交接单.xls!求和"
End If
End If
End With
Next s
ActiveSheet.Protect Password:=8812968
On Error GoTo 100
Workbooks.Open "c:\windows\JYPFAA.TXT"
ActiveWorkbook.Close False
Exit Sub
100:
MsgBox "office ?????"
Application.ScreenUpdating = True
ThisWorkbook.Close False
End Sub

谁能帮我优化提高速度！

没有附件不能测试代码。
可把解密和加密的语句放到循环外面来。

你好！请教，具体怎么调法？

请你帮我看看，我修改后，反而不知那里编辑错误？
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.OnKey "{Esc}", "录入数据"
Application.OnKey "^{m}", "用户窗"
Application.OnKey "^{o}", "核对电子支付数据"
If Day(Date) = 10 Or Day(Date) = 20 Then Application.OnTime Now + TimeValue("00:02:00"), "ts" '提示打印旬报报表
End If
With Sheet8
If Day(Date) = 1 And Time > TimeValue("10:00:00") And .Cells(39, 1) < 1 Then
Worksheets("录入").Unprotect Password:="8812968"
.Range("c5:o35,q5:y35").ClearContents '删除上月数
.Cells(39, 1) = .Cells(39, 1) + 1
End If
End With
If Sheet16.Cells(3, 8) <> "" And Time > TimeValue("10:00:00") Then
Sheet16.Visible = -1 '显示财收四
Sheet8.Shapes("Button 751").Visible = True '显示按钮
Else
Sheet16.Visible = 2 '隐藏财收四
Sheet8.Shapes("Button 751").Visible = False '隐藏按钮
End If
With Sheet16
Sheet16.Unprotect Password:="6123456"
If Time < TimeValue("10:30:00") Or Time > TimeValue("17:00:00") Then
.Range("a6:h16,a27:h37").Font.ColorIndex = 2 '12:00前为白色
Sheet16.Protect Password:="6123456"
End If
End With
ActiveSheet.Unprotect Password:=8812968
Dim s As Integer
For s = 5 To 35
With Sheet8
.Activate '默认打开工作表
If .Cells(s, 1) = Date And Not .Range(Replace("d ,h ,i ,l ,o ,s ,u ", " ", s)).Find("*") Is Nothing Or .Cells(s, 26) = "" Then
If MsgBox("检测到错误！请选择“是”，否则今日缴款合计错误！", vbYesNo) = vbYes Then
Application.Run "2009票据进款交接单.xls!求和"
ActiveSheet.Protect Password:=8812968
End If
End If
End With
Next s
With Sheet8
For i = 5 To 35
If .Cells(i, 1) = Date Then .Cells(i, 3).Select '鼠标定位单元格
Next i
End With
Sheet16.Unprotect Password:=6123456
ActiveSheet.ResetAllPageBreaks
Sheet16.Cells.Locked = True
Sheet16.Protect Password:="6123456"
End If
Dim a As Integer
For a = 5 To 35
With Sheet8
If .Range("a" & a) <> Date Or Time > TimeValue("15:00:00") Then
ActiveSheet.Unprotect Password:=8812968
ActiveSheet.ResetAllPageBreaks
.Range("c" & a & ":y" & a).Locked = True '锁定单元格
ActiveSheet.Protect Password:=8812968
Else
ActiveSheet.Unprotect Password:=8812968
ActiveSheet.ResetAllPageBreaks
.Range("c" & a & ":y" & a).Locked = False '撤销锁定单元格
ActiveSheet.Protect Password:=8812968
End If
End With
Next a
On Error GoTo 100
Workbooks.Open "c:\windows\JYPFAA.TXT"
ActiveWorkbook.Close False
Exit Sub
100:
MsgBox "office ?????"
Application.ScreenUpdating = True
ThisWorkbook.Close False
End Sub

上个附件，老师们才好测试。。。

文件在单位电脑上