使用期限自杀代码的修改

luanyu6688

下段是自杀代码，但是我不想把日期保存到注册表，我想把他保保存到SHEET（注册）表中的D1单元格中，不知怎么修改

Sub Auto_Open()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))
    s = d.serialnumber    '磁盘序列号
    If s = 235278334 Then Exit Sub '要使用的电脑磁盘序列号
   
    Dim FirstDate, de, days
    FirstDate = Date
    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    If de = "" Then   '如果取不到值
        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        MsgBox "本文件可使用60天，今天是第1次使用", , "提示"
    Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 60 Then    '如果文件使用超过60天
            MsgBox "已超过使用期限，本文件将自杀", , "警告"
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改为只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
        MsgBox "本文件已使用" & days & "天，还有" & 60 - days & "天可使用", , "提示"
    End If
End Sub

sjlung

如下所示即可达到楼主的要求。

Sub Auto_Open()
    Dim fs, d, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(ThisWorkbook.Path)))
    s = d.serialnumber    '磁盘序列号
    If s = 235278334 Then Exit Sub '要使用的电脑磁盘序列号
   
    Dim FirstDate, de, days
    FirstDate = Date
'    de = GetSetting("XXX", "YYY", "date", "")  '从注册表取值
    de = Worksheets("注册").Range("d1")
    If de = "" Then   '如果取不到值
'        SaveSetting "XXX", "YYY", "date", FirstDate  '把日期保存到注册表
        Worksheets("注册").Range("d1") = FirstDate
        MsgBox "本文件可使用60天，今天是第1次使用", , "提示"
    Else
        days = Date - CDate(de)  '计算文件使用的天数
        If days > 60 Then    '如果文件使用超过60天
            MsgBox "已超过使用期限，本文件将自杀", , "警告"
            ThisWorkbook.ChangeFileAccess xlReadOnly  '改?只读属性
            Kill ThisWorkbook.FullName  '自杀
            ThisWorkbook.Close False  '关闭不保存
        End If
        MsgBox "本文件已使用" & days & "天，还有" & 60 - days & "天可使用", , "提示"
    End If
End Sub