Programmer la date d'expiration sur ce code
Bonjour,
Besoin d'aide SVP . Je cherche à programmer la date d'expiration de mon appli pour le 20/01/2020 pour le classeur logiciel que je joins a ma demande. le probleme est que je ne comprends pas grand chose en VBA alors .
Sub TimeBombWithDefinedName()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TimeBombWithDefinedName
' This procedure uses a defined name to store this workbook's
' expiration date. If the expiration date has passed, a
' MsgBox is displayed and this workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ExpirationDate As String
On Error Resume Next
ExpirationDate = Mid(ThisWorkbook.Names("ExpirationDate").Value, 2)
If Err.Number <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''
' Name doesn't exist. Create it.
'''''''''''''''''''''''''''''''''''''''''''
ExpirationDate = CStr(DateSerial(Year(Now), _
Month(Now), Day(Now) + C_NUM_DAYS_UNTIL_EXPIRATION))
ThisWorkbook.Names.Add Name:="ExpirationDate", _
RefersTo:=Format(ExpirationDate, "short date"), _
Visible:=False
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If the today is past the expiration date, close the
' workbook. If the defined name didn't exist, we need
' to Save the workbook to save the newly created name.
''''''''''''''''''''''''''''''''''''''''''''''''''''''
If CDate(Now) > CDate(ExpirationDate) Then
MsgBox "This workbook trial period has expired.", vbOKOnly
ThisWorkbook.Close savechanges:=False
End If
End Sub
Bonjour,
Une période d'essai sur un fichier Excel : totalement utopique !
merci beaucoup pour cette leçon qu'est ce que vous me proposez pour sécuriser une appli patricemerci beaucoup pour cette leçon qu'est ce que vous me proposez pour sécuriser une appli patrice
Bonjour,
je déclare que je suis d'accord avec Patrice33740, mais juste pour essayer, in ThisWorkBook
Option Explicit
Private Const JoursDeDonnees As Long = 30
Private Sub Workbook_Open()
Dim aName As Name
Dim dDatelimite As Date
With Me
On Error Resume Next
Set aName = .Names("Datelimite")
dDatelimite = Evaluate(aName.RefersTo)
On Error GoTo 0
If aName Is Nothing Then
dDatelimite = Date + JoursDeDonnees
Set aName = .Names.Add(Name:="Datelimite", _
RefersTo:=dDatelimite, Visible:=False)
End If
If CDate(Now) > dDatelimite Then
Call MsgBox(Prompt:="Ce fichier a expiré!", _
Buttons:=vbOKOnly, _
Title:="Date limite!")
.Close SaveChanges:=False
Else
Call MsgBox(Prompt:="Il y a " & dDatelimite - Date _
& " jours avant la date limite du fichier " & .Name, _
Buttons:=vbInformation, _
Title:="Avertissement")
End If
End With