[已解决]修改代码

武林长风

下面的附件是别人的（输入的账号是123），想请大师帮忙修改一下。要求：打开excel出现提示输入账号，如输入123456789，则显示查询工作表，在查询工作表里的灰色单元格显示这个人的打卡信息，若账号连续输错3次则工作簿自杀。（打卡的全部信息在数据工作表里） 新建文件夹.rar (7.62 KB, 下载次数: 8)

2013-12-28 11:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

冥王

2013-12-28 13:28

刚才测试的时候不小心把测试的代码文件删了
试一下这个行不行

1. Private Sub Workbook_Open()
   
2. On Error Resume Next
   
3.     Static i As Byte
   
4.     Dim myrow As Integer
   
5.     Application.Visible = False
   
6.     Sheets(1).Select
   
7. star:
   
8.     If i > 3 Then
   
9.         KILLME
   
10.     End If
    
11.     XX = Application.InputBox("输入密码", "提示", Type:=1)
    
12.     myrow = WorksheetFunction.Match(XX, Sheets("数据").Range("a:a"), 0)
    
13.     If myrow > 0 Then
    
14.         Application.Visible = True
    
15.         Sheets("数据").Cells(myrow, 1).Resize(1, 6).Copy Sheets("查询").Cells(13, 3)
    
16.     Else
    
17.         i = i + 1
    
18.         GoTo star:
    
19.     End If
    
20. End Sub
    
21. 
    
22. 
    
23. Public Sub KILLME()
    
24.     Application.DisplayAlerts = False
    
25.     ActiveWorkbook.ChangeFileAccess xlReadOnly
    
26.     Kill ActiveWorkbook.FullName
    
27.     ThisWorkbook.Close False
    
28. End Sub
    

复制代码

跳转到最佳答案楼层

武林长风

武林长风

期待高手的答案！

武林长风

看来有点难度

武林长风

只需修改提示的账号与数据工作表里的账号检验功能，对就显示相关信息，错误3次就自动删除。

冥王

刚才测试的时候不小心把测试的代码文件删了
试一下这个行不行

1. Private Sub Workbook_Open()
   
2. On Error Resume Next
   
3.     Static i As Byte
   
4.     Dim myrow As Integer
   
5.     Application.Visible = False
   
6.     Sheets(1).Select
   
7. star:
   
8.     If i > 3 Then
   
9.         KILLME
   
10.     End If
    
11.     XX = Application.InputBox("输入密码", "提示", Type:=1)
    
12.     myrow = WorksheetFunction.Match(XX, Sheets("数据").Range("a:a"), 0)
    
13.     If myrow > 0 Then
    
14.         Application.Visible = True
    
15.         Sheets("数据").Cells(myrow, 1).Resize(1, 6).Copy Sheets("查询").Cells(13, 3)
    
16.     Else
    
17.         i = i + 1
    
18.         GoTo star:
    
19.     End If
    
20. End Sub
    
21. 
    
22. 
    
23. Public Sub KILLME()
    
24.     Application.DisplayAlerts = False
    
25.     ActiveWorkbook.ChangeFileAccess xlReadOnly
    
26.     Kill ActiveWorkbook.FullName
    
27.     ThisWorkbook.Close False
    
28. End Sub
    

复制代码

武林长风

冥王 发表于 2013-12-28 13:28
刚才测试的时候不小心把测试的代码文件删了
试一下这个行不行

可否再加个：1、不启用宏就看不到这个查询工作表或工作簿关闭；2、输入错误出现提示：卡号错误，请重新输入，还有几次机会（最多3次），3次全错就自动删除，麻烦您了！

冥王

武林长风 发表于 2013-12-28 13:42
可否再加个：1、不启用宏就看不到这个查询工作表或工作簿关闭；2、输入错误出现提示：卡号错误，请重新输 ...

那就这样，工作簿关闭前把除sheet3这张空表外的所有工作表超级隐藏，打开工作簿时不启用宏就只能看到这张空表，启用宏则弹出输入窗口，要求输入密码

1. Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
2. On Error Resume Next
   
3. Application.DisplayAlerts = False
   
4.   For Each st In ThisWorkbook.Sheets
   
5.     If st.Name <> "Sheet3" Then
   
6.        st.Visible = xlSheetVeryHidden
   
7.     End If
   
8.   Next
   
9. ThisWorkbook.Save
   
10. Application.DisplayAlerts = True
    
11. End Sub
    
12. 
    
13. Private Sub Workbook_Open()
    
14. On Error Resume Next
    
15.     Static i As Byte
    
16.     Dim myrow As Integer
    
17.     Application.Visible = False
    
18. star:
    
19.     If i > 3 Then
    
20.         KILLME
    
21.     End If
    
22.     XX = Application.InputBox("输入密码", "提示", Type:=1)
    
23.     myrow = WorksheetFunction.Match(XX, Sheets("数据").Range("a:a"), 0)
    
24.     If myrow > 0 Then
    
25.         ThisWorkbook.Sheets("查询").Visible = True
    
26.         Application.Visible = True
    
27.         Sheets("数据").Cells(myrow, 1).Resize(1, 6).Copy Sheets("查询").Cells(13, 3)
    
28.     Else
    
29.         i = i + 1
    
30.         MsgBox "卡号错误，请重新输入，还有" & 3 - i & "次机会"
    
31.         GoTo star:
    
32.     End If
    
33.     Sheets(1).Select
    
34. End Sub
    
35. 
    
36. 
    
37. Public Sub KILLME()
    
38.     Application.DisplayAlerts = False
    
39.     ActiveWorkbook.ChangeFileAccess xlReadOnly
    
40.     Kill ActiveWorkbook.FullName
    
41.     ThisWorkbook.Close False
    
42. End Sub

复制代码

武林长风

冥王 发表于 2013-12-28 14:17
那就这样，工作簿关闭前把除sheet3这张空表外的所有工作表超级隐藏，打开工作簿时不启用宏就只能看到这张空 ...

怎么输错1次就关闭，再输得重新打卡，可否连续3次输入？