0

我有一个 Excel 工作表，我需要设置一个到期日期，以便在到期日期发生时文件变得无用，他们必须与我联系以获取文件的新版本。

我编写了一个脚本，如果未启用宏并且工作表读取必须启用宏才能继续，则强制显示第一个工作表并隐藏第二个工作表（包含日期）。一旦他们启用了宏，第二张表就会变得可见，他们可以利用这些数据。启用宏后，脚本将运行到期日期命令，如果当前日期超过到期日期，则会显示一个消息窗口，提醒用户他们的文件已过期。问题是，关闭此消息窗口后，excel 会提示用户保存、不保存或取消。如果用户选择取消，则出现的下一个消息框是到期日期窗口，到期日期报告他们还有负天数。然后他们可以关闭该窗口并访问计算器。

我已经涉足了下面的“ActiveWorkbook.Save = True”功能，但没有使用。

Private Sub Workbook_BeforeClose(Cancel As Boolean) ActiveWorkbook.Saved = True End Sub

它禁用了需要用户启用宏的我的工作表，这是不行的，基本上使文件无用。

我附上了VBA脚本，希望你们能帮忙。

非常感谢！

这是代码：

Private Const dsWarningSheet As String = "sheet1" 'Enter name of the Entry/Warning Page

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

For Each ds In ActiveWorkbook.Sheets
If LCase(dsWarningSheet) = LCase(ds.Name) Then
ds.Visible = True
End If
Next

结束子

私有子 Workbook_Open()

Dim myCount        'This line of code is optional
Dim i                     'This line of code is optional
Dim Edate As Date
On Error Resume Next

myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).Visible = True
If i = myCount Then
Sheets(1).Visible = xlVeryHidden
End If
Next i

Edate = Format("13/01/2012", "DD/MM/YYYY") ' Replace this with the date you want
If Date > Edate Then
MsgBox ("This worksheet was valid upto " & Format(Edate, "dd-mmm-yyyy") & " and will be closed: Please contact John Smith at Company ABC to purchase a new version of this calculator")
ActiveWorkbook.Close
End If
If Edate - Date < 30 Then
MsgBox ("This worksheet expires on " & Format(Edate, "dd-mmm-yyyy") & " You have " & Edate - Date & " Days left")
End If

结束子

Private Sub Workbook_BeforeClose（取消为布尔值） 

Dim myCount        'This line of code is optional
Dim i                     'This line of code is optional
On Error Resume Next
myCount = Application.Sheets.Count
Sheets(1).Visible = True
Range("A1").Select
For i = 2 To myCount
Sheets(i).Visible = xlVeryHidden
If i = myCount Then
End If
Next i
ActiveWorkbook.Save

结束子

私有子工作簿_Openxx()

Dim myCount        'This line of code is optional
Dim i                     'This line of code is optional
On Error Resume Next

myCount = Application.Sheets.Count
For i = 2 To myCount
Sheets(i).Visible = True
If i = myCount Then
Sheets(1).Visible = xlVeryHidden
End If
Next i

结束子

4

2 回答 2

0

关闭工作簿并告诉它不要保存。见下文

Dim wb as workbook
set wb = <yourworkbook>

wb.Close SaveChanges:=Excel.XlSaveAction.xlDoNotSaveChanges
于 2013-04-22T21:22:04.910 回答
0

这是我在此的头一篇博文。我为这个问题创建了一个解决方案，我想与你分享。

如果您想为 Excel 工作簿、加载项等设置到期日期，您可以使用下面的代码，该代码将给用户一条消息，然后在这种情况下删除、关闭和卸载加载项。

您只需将其添加到文件的 Workbook_Open 事件中，然后在项目的 VBA 代码上输入密码。

当到期日期发生并且用户打开文件时，它将被完全删除。

Private Sub Workbook_Open()

Dim exdate As Date
Dim i As Integer

anul = 2015   ' (year) change these according to your expiration date
luna = 11     '(month)
ziua = 1      '(day)     

exdate = DateSerial(anul, luna, ziua)

If Date > exdate Then
    MsgBox ("The application " & ThisWorkbook.Name & " has expired !" & vbNewLine & vbNewLine _
    & "Expiration set up date is: " & exdate & " :)" & vbNewLine & vbNewLine _
    & "Contact xxx person(you) to renew the version !"), vbCritical, ThisWorkbook.Name

    expired_file = ThisWorkbook.Path & "\" & ThisWorkbook.Name


   On Error GoTo ErrorHandler
With Workbooks(ThisWorkbook.Name)
    If .Path <> "" Then

        .Saved = True
        .ChangeFileAccess xlReadOnly

        Kill expired_file

        'get the name of the addin if it is addin and unistall addin
        If Application.Version >= 12 Then
         i = 5
        Else: i = 4
        End If

        If Right(ThisWorkbook.Name, i) = ".xlam" Or Right(ThisWorkbook.Name, i) = ".xla" Then
            wbName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - i)
             'uninstall addin if it is installed
             If AddIns(wbName).Installed = True Then
                AddIns(wbName).Installed = False
              End If
        End If

        .Close

    End If
End With

Exit Sub

End If

Exit Sub

ErrorHandler:
MsgBox "Fail to delete file.. "
Exit Sub

End Sub

现在，我的问题是，如何编写代码来检查用户使用文件的计算机或他离开公司的日期？

我想要某种代码，不允许用户在其他电脑上使用文件，而不是工作中的文件。（为了在他们离开公司时不带走excel工具）。

于 2015-11-29T09:51:50.890 回答