使用Excel到期的工作表

Question

我有一個Excel工作表，我需要設置截止日期上，這樣當出現將過期的文件變得毫無用處，他們必須聯繫我獲得該文件的新版本。

我寫了強制要顯示的第一個工作表和隱藏工作表兩（其中包含日期），如果沒有啓用宏和片材讀取宏必須能夠繼續腳本。一旦它們啓用宏表，表格2變得可見並且它們可以利用這些數據。一旦宏啓用腳本運行的到期日的命令，並且當前日期已過有效期限顯示一個消息窗口警告用戶他們的文件過期。問題是，在此消息窗口關閉後，excel會提示用戶保存，不保存或取消。如果用戶選擇取消，則顯示的下一個消息框是到期日期窗口，並且過期日期報告他們有負日子。然後，他們可以關閉該窗口並訪問計算器。

我已經涉足與「ActiveWorkbook.Save = TRUE」之下，但沒有avial功能。

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 

私人小組Workbook_BeforeSave（BYVAL SaveAsUI由於布爾，取消由於布爾）

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 

結束子

私人小組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 

結束子

私人小組Workbook_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 

結束子

Answer 1

關閉工作簿並告訴它不要保存。看下面

Dim wb as workbook 
set wb = <yourworkbook> 

wb.Close SaveChanges:=Excel.XlSaveAction.xlDoNotSaveChanges 

Answer 2

這是我的第一篇文章在這裏。我爲這個問題創建了一個解決方案，我想與你分享。

如果您想爲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工具）。