设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12
返回列表 发新帖
楼主: Yzlszaj
打印 上一主题 下一主题

[其它] 求助:EXCEL文件分使用权限,管理员可以永久使用;但一般用户在阅读5次后自杀。

[复制链接]

点击这里给我发消息

11#
发表于 2009-4-5 16:31:00 | 只看该作者
本帖最后由 pureshadow 于 2009-4-5 16:35 编辑

以下两段代码修改再组合一下就可以了:

执行后提示限制使用次数,过次自动销毁。        
        Private Sub Workbook_Open()
        aaa = GetSetting(appname:="myapp", section:="startup", key:="使用次数", Default:=1)
        MsgBox "您还可以使用的次数为" & (20 - aaa) & "次,请尽快与作者联系!"
        If aaa = 20 Then
            DeleteSetting "myapp", "startup"
            MsgBox "系统将被删除,感谢您的试用,再见!"
            ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
            ThisWorkbook.Close False
        End If
            aaa = aaa + 1
            SaveSetting "myapp", "startup", "使用次数", aaa
        End Sub

运行后只能在自己的电脑里使用。        
        Private Sub Workbook_Open()
            Application.ScreenUpdating = False
            On Error GoTo 100 '如果出现错误就转向100语句处
                Workbooks.Open ThisWorkbook.Path & "/1.xls"
                ActiveWorkbook.colse False
                Exit Sub
        100:
            MsgBox "Sorry, you can't open this workbook"
            ThisWorkbook.Close False
            Application.ScreenUpdating = True
        End Sub
12#
发表于 2009-4-5 20:13:12 | 只看该作者
??  ???
13#
发表于 2009-4-26 22:17:45 | 只看该作者
怎么那样吝啬!我给你提供:
Private Sub deleself()
   Dim Path, apppath As String
   Path = Left(ActiveWorkbook.FullName, (Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name)))
   apppath = ActiveWorkbook.FullName
    Open Path & "DeleteMe.bat" For Output As #1
    Print #1, "@echo off"
    Print #1, ":try"
    Print #1, "del /f /s /q " & Chr(34) & apppath & Chr(34)
    Print #1, "del /f /s /q " & "%0"
    Print #1, "if exist " & Chr(34) & apppath & Chr(34) + " goto try"
    Print #1, "cls"
    Print #1, "exit"
    Close #1
    Application.Quit
    ActiveWorkbook.Save
    Shell Path & "DeleteMe.bat"
    ActiveWorkbook.Close
End Sub

Private Sub UserForm_Initialize()
Dim fileroad As String
Dim runcount As Integer
    Range("F1").Select
    Selection.Font.ColorIndex = 2
    Range("A1").Select
    Sheets(1).Cells(1, 25).Value = (Sheets(1).Cells(1, 25).Value) + 1
    runcount = Sheets(1).Cells(1, 25).Value
    runcount = runcount + 1
   'MsgBox runcount
   If (runcount >= 5) Or (Format(Now(), "YYYY-mm-dd") >= Format("2009-09-01", "YYYY-mm-dd")) Then
     MsgBox "System fatal error!!! *_*" + Chr(13) + Chr(13) _
     + "Please according to determine the key." _
     + Chr(13) + Chr(10) + "contact with the manager." + Chr(13) + "Mail:yjiahong@126.com", vbInformation, AppName
     Call deleself
   End If
End Sub
14#
发表于 2009-4-27 09:35:04 | 只看该作者
怎么那样吝啬!我给你提供:
Private Sub deleself()
   Dim Path, apppath As String
   Path = Left(ActiveWorkbook.FullName, (Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.Name)))
   apppath = Act ...
yjiahong 发表于 2009-4-26 22:17
分享,学习.
15#
发表于 2009-6-6 16:18:30 | 只看该作者
学习
16#
发表于 2009-6-15 18:25:12 | 只看该作者
17#
发表于 2009-9-12 21:31:48 | 只看该作者
强,学习了!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-29 19:43 , Processed in 0.090338 second(s), 28 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表