如何用VBA设置EXCEL使用的有效期？[求助]

好东东,

要飞了....

我的excel时间限制代码(有效期) 和 防止复制 (指定电脑外不能使用)

超过使用期限,可以提供远程再注册

要求: 有一个表(不是:sheet1)命名为"finish"

Sheets("finish").Range("iv65535")填写允许的天数

Sheets("finish").Range("iv65535")格式 自定义:d/m/yyyy 字体颜色为白色

第一次使用时:禁用宏,将finish表的iv65536,iv65535,iu65536清空

Private Sub Workbook_Open()
    Dim fs, d, s, Sh As Worksheet
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(Me.Path)))
    s = d.serialnumber
If Sheets("finish").Range("iv65536") = "" Then Sheets("finish").Range("iv65536") = Date
    If Sheets("finish").Range("iv65535") < Date - Sheets("finish").Range("iv65536") Or Date - Sheets("finish").Range("iv65536") < 0 Then
        MsgBox "已经超出使用期限." & Chr(10) & Chr(10) & "请联系作者：fokus@sina.com" & Chr(10) & Chr(10) & "QQ号码：14885553"
      Application.EnableEvents = False
     Me.Close (flase)
    Application.EnableEvents = True
     End If
If Sheets("finish").Range("iu65536") = "" Then Sheets("finish").Range("iu65536") = s
    If s <> Sheets("finish").Range("iu65536") Then
      MsgBox "你使用是文件副本吧?不好意思,我不能让你看到,请支持正版" & Chr(10) & Chr(10) & "你的磁盘序列号是:" & s
      MsgBox "你没有得到授权，不能在本机使用" & Chr(10) & Chr(10) & "请联系作者：fokus@sina.com" & Chr(10) & Chr(10) & "QQ号码：14885553"
     
    Else
     'MsgBox "恭喜你,你马上就可以看到我的真面目了"
      For Each Sh In Me.Worksheets
        Sh.Visible = True
      Next Sh
     Sheets("finish").Visible = xlVeryHidden
     Sheet1.Activate
 
    End If
End Sub
Private Sub Workbook_BeforeClose(cancel As Boolean)
  Dim Sh As Worksheet
  Sheets("finish").Visible = True
  For Each Sh In Me.Worksheets
   If Sh.Name <> "finish" Then Sh.Visible = xlSheetVeryHidden
  Next Sh
  Me.Save
End Sub

zGlJb3WK.rar (14.69 KB, 下载次数: 1739)

2006-11-18 13:49 上传

点击文件名下载附件

多此一問 [em06][em06][em06]

還有中國龍 = Chijanzen