sachin katariya
New Member
- Joined
- Jul 13, 2020
- Messages
- 21
- Office Version
- 2013
- Platform
- Windows
I have coding of expiry of excel
But what if I Change the date of my PC manually ?
Private Sub Workbook_Open()
Application.Visible = False
Application.Calculation = xlCalculationManual
If Application.Version < "15.0" Then
MsgBox "This Software is not Compatible with this Version of Application. Please Install Microsoft Office 2013 or Above"
Application.Quit
Exit Sub
Else
On Error Resume Next
Dim Expiry As Date
Dim wb As Workbook: Set wb = SHEET
Expiry = wb.Worksheets("Data").Range("B1")
If Date > Expiry Then
Application.DisplayAlerts = False
MsgBox "This Sheet is Expired on " & Expiry
For Each wsSheet In Worksheets
If wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = xlSheetVeryHidden
End If
Sheets("Data").Select
Next wsSheet
Application.DisplayAlerts = True
Else
Worksheets("Dashboard").Visible = True
MsgBox "You have " & Expiry - Date & " Day(s) left. Your Sheet will expire on " & Expiry
For Each wsSheet In Worksheets
If wsSheet.Name = "Dashboard" Or wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = False
End If
Next wsSheet
Sheets("Dashboard").Select
End If
End If
Application.Visible = True
Application.Calculation = xlCalculationAutomatic
End Sub
But what if I Change the date of my PC manually ?
Private Sub Workbook_Open()
Application.Visible = False
Application.Calculation = xlCalculationManual
If Application.Version < "15.0" Then
MsgBox "This Software is not Compatible with this Version of Application. Please Install Microsoft Office 2013 or Above"
Application.Quit
Exit Sub
Else
On Error Resume Next
Dim Expiry As Date
Dim wb As Workbook: Set wb = SHEET
Expiry = wb.Worksheets("Data").Range("B1")
If Date > Expiry Then
Application.DisplayAlerts = False
MsgBox "This Sheet is Expired on " & Expiry
For Each wsSheet In Worksheets
If wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = xlSheetVeryHidden
End If
Sheets("Data").Select
Next wsSheet
Application.DisplayAlerts = True
Else
Worksheets("Dashboard").Visible = True
MsgBox "You have " & Expiry - Date & " Day(s) left. Your Sheet will expire on " & Expiry
For Each wsSheet In Worksheets
If wsSheet.Name = "Dashboard" Or wsSheet.Name = "Data" Then
wsSheet.Visible = True
Else
wsSheet.Visible = False
End If
Next wsSheet
Sheets("Dashboard").Select
End If
End If
Application.Visible = True
Application.Calculation = xlCalculationAutomatic
End Sub