Hamadouche
XLDnaute Nouveau
Salut tout le monde;
Je veux limiter l’accès à mon fichier par une date et je n'arrive pas à placer ceci :
Private Sub Workbook_Open()
Application.ScreenUpdating = False 'l'utilisateur ne voit pas les changement sur son écran
'la date d'expiration
DateExpiration = DateSerial(2021, 01, 31) ' <= choisissez la date d'expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
'compare la date d'expiration avec la date d'aujourd'hui
If DateExpiration <= Date Then
'le code de l'action à effectuer quand le fichier est expiré
'par exemple un message:
MsgBox "Ce fichier n'est plus valide..."
Else
End If
Application.ScreenUpdating = True 'on réenclanche l'affichage des changements
End Sub
Avec ce que j'ai déjà placé :
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.CutCopyMode = False
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
Application.CutCopyMode = False
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_Deactivate()
Application.CutCopyMode = False
End Sub
Private Sub Workbook_Open()
UserForm1.Show
Application.CellDragAndDrop = False
Application.CutCopyMode = False
Application.CommandBars("Ply").Enabled = False
End Sub
Private Sub Workbook_Activate()
Application.DisplayFullScreen = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Menu").Visible = True
Sheets("Menu").Select
'Si l'utilisateur répond Non, la variable Cancel vaudra True (ce qui annulera la fermeture)
If MsgBox("Etes-vous certain de vouloir quitter Best Stock Challenge ?", 36, "Confirmation") = vbNo Then
Cancel = True
End If
End Sub
Merci d'avance.
Je veux limiter l’accès à mon fichier par une date et je n'arrive pas à placer ceci :
Private Sub Workbook_Open()
Application.ScreenUpdating = False 'l'utilisateur ne voit pas les changement sur son écran
'la date d'expiration
DateExpiration = DateSerial(2021, 01, 31) ' <= choisissez la date d'expiration >>> via la fonction DateSerial avec les paramètres (aaaa, mm, jj)
'compare la date d'expiration avec la date d'aujourd'hui
If DateExpiration <= Date Then
'le code de l'action à effectuer quand le fichier est expiré
'par exemple un message:
MsgBox "Ce fichier n'est plus valide..."
Else
End If
Application.ScreenUpdating = True 'on réenclanche l'affichage des changements
End Sub
Avec ce que j'ai déjà placé :
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.CutCopyMode = False
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
Application.CutCopyMode = False
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_Deactivate()
Application.CutCopyMode = False
End Sub
Private Sub Workbook_Open()
UserForm1.Show
Application.CellDragAndDrop = False
Application.CutCopyMode = False
Application.CommandBars("Ply").Enabled = False
End Sub
Private Sub Workbook_Activate()
Application.DisplayFullScreen = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Menu").Visible = True
Sheets("Menu").Select
'Si l'utilisateur répond Non, la variable Cancel vaudra True (ce qui annulera la fermeture)
If MsgBox("Etes-vous certain de vouloir quitter Best Stock Challenge ?", 36, "Confirmation") = vbNo Then
Cancel = True
End If
End Sub
Merci d'avance.