[已解决]两段VBA代码求整合在一起

cqzcs

下面有两段单独用都正常的代码，我想让它们在一起也可以同时工作，请老师帮忙整合一下，谢谢！！！
第一段：
Private Sub Workbook_Open()
Application.ScreenUpdating = False
On Error GoTo 100
Workbooks.Open ThisWorkbook.Path & "/验证.XLS"
ActiveWorkbook.Close False
Exit Sub
100:
MsgBox "你无法使用该文件,请与文件作者联系"
ThisWorkbook.Close False
Application.ScreenUpdating = True
End Sub

第二段：
Private Sub Workbook_Open()
    If Now() >= #2/13/2016# Then
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        Application.Quit
    End If
    On Error Resume Next
    For Each sh In ThisWorkbook.Sheets
        sh.Activate
        ActiveSheet.Range("A8").Select
        For i = 8 To Range("a65536").End(xlUp).Row
            If Len(Cells(i, 1)) = 0 Then r = i - 1: Exit For
        Next i
        ActiveWindow.SmallScroll Down:=r - 53
    Next sh
    On Error GoTo 0
End Sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-25 19:44

1. Private Sub Workbook_Open()
   
2.     Application.ScreenUpdating = False
   
3.     On Error GoTo 100
   
4.     Workbooks.Open ThisWorkbook.Path & "/验证.XLS"
   
5.     ActiveWorkbook.Close False
   
6.     If Now() >= #2/13/2016# Then
   
7.         ActiveWorkbook.ChangeFileAccess xlReadOnly
   
8.         Kill ActiveWorkbook.FullName
   
9.         Application.Quit
   
10.     End If
    
11. Check:
    
12.     On Error Resume Next
    
13.     For Each sh In ThisWorkbook.Sheets
    
14.         sh.Activate
    
15.         ActiveSheet.Range("A8").Select
    
16.         For i = 8 To Range("a65536").End(xlUp).Row
    
17.             If Len(Cells(i, 1)) = 0 Then r = i - 1: Exit For
    
18.         Next i
    
19.         ActiveWindow.SmallScroll Down:=r - 53
    
20.     Next sh
    
21.     Exit Sub
    
22. 100:
    
23.     MsgBox "你无法使用该文件,请与文件作者联系"
    
24.     ThisWorkbook.Close False
    
25.     Application.ScreenUpdating = True
    
26.     GoTo Check
    
27. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Private Sub Workbook_Open()
   
2.     Application.ScreenUpdating = False
   
3.     On Error GoTo 100
   
4.     Workbooks.Open ThisWorkbook.Path & "/验证.XLS"
   
5.     ActiveWorkbook.Close False
   
6.     If Now() >= #2/13/2016# Then
   
7.         ActiveWorkbook.ChangeFileAccess xlReadOnly
   
8.         Kill ActiveWorkbook.FullName
   
9.         Application.Quit
   
10.     End If
    
11. Check:
    
12.     On Error Resume Next
    
13.     For Each sh In ThisWorkbook.Sheets
    
14.         sh.Activate
    
15.         ActiveSheet.Range("A8").Select
    
16.         For i = 8 To Range("a65536").End(xlUp).Row
    
17.             If Len(Cells(i, 1)) = 0 Then r = i - 1: Exit For
    
18.         Next i
    
19.         ActiveWindow.SmallScroll Down:=r - 53
    
20.     Next sh
    
21.     Exit Sub
    
22. 100:
    
23.     MsgBox "你无法使用该文件,请与文件作者联系"
    
24.     ThisWorkbook.Close False
    
25.     Application.ScreenUpdating = True
    
26.     GoTo Check
    
27. End Sub

复制代码

hwc2ycy

也不知道你的意图，二段代码实现的是不同的功能。

在合并的代码里，不管是否能访问验证.xls，对于SHEETS的操作还是照样执行了。

cqzcs

谢谢班长