Interdire l'accés à une page aprés qqs jours

Le 09/04/2022 à 22:25

Bonjour à tous,

J'ai essayé la procédure de Sébastien, mais çà bug.

Sub exemple()
    Application.OnTime Now + TimeValue("00:00:05"), "attente"
End Sub

Sub attente()
    MsgBox "5 secondes se sont écoulées !"

Aprés je voudrais le lier à l'activation d'une feuille différente :

'Private Sub Worksheet_Activate()
'Sheets("ecole").Activate
'End Sub

et protéger l'action par un mot de passe:

ActiveSheet.Unprotect ("TOTO")

Merci

Le 09/04/2022 à 23:06

Bonsoir,

Quelques jours à partir de quand ?
Si c'est à partir de la première ouverture on peut imaginer un "nom" sous Excel qui aurait comme valeur -1 initialement,
A l'ouverture du fichier le code VBA teste la valeur de "nom" :
si = à -1 alors première ouverture, le code passe la valeur à l'index du jour
si > à 1 le code VBA va tester cette valeur avec la date du jour afin de connaitre la différence, si cette différence >= à 10 jours (par exemple" alors on masque la feuille concernée.

Une des propriété des noms sous Excel par VBA est que l'on peut les rendre "invisibles" comme j'ai fait sur mon application "SevenSfruitS".

@ bientôt

LouReed

Le 10/04/2022 à 00:50

Bsoir LouReed,

En cherchant un peu, çà devrait le faire comme çà, dans le code de la page accueil qui pilote l'application :

Private Sub Worksheet_Activate()
Dim dat1 As Date, dat2 As Date
    dat1 = Now()
    ajout = 10 'Ajout de 10 jours
    dat2 = DateAdd("d", ajout, dat1)
If dat1 >= dat2 Then
Sheets("ecole").Activate
End If
End Sub

J'ai été voir ton appli sur la machine à sous, et excel m'a avertit de potentiels virus, et j'ai pu voir ta page en plein écran avant que le fichier se ferme.

Sinon Merci

Le 10/04/2022 à 09:06

Bonjour

On me l'a signalé déjà et je ne sais d'où ça vient, je ce crois qu'il y a la discussion sur le fil.

Sébastien teste toutes les application avec un site "All Antivirus" et elle a passé les tests donc les alertes sont des "faux positif"

@ bientôt

LouReeD

Le 11/04/2022 à 07:11

Bonjour à tous,

En fait c'est pas tout ce que je voudrais.

Il faudrait une page qui s'ouvre une fois, et pas à la seconde ouverture du fichier, pour demander à l'utilisateur qu'il lise une séquence sur les droits d'auteur, comme Sébastien dans ses fichiers EP, et qu'il approuve ou pas à la fin du message. De ce style :

If MsgBox("Le CLIENT est responsable du respect du Contrat par les Utilisateurs Autorisés." _
& "Le CLIENT doit empêcher toute utilisation non autorisée de l'application Orienthur, et notifier sans délai à l'éditeur " _
& "FP toute utilisation non autorisée dont il aurait connaissance." & Chr(10) _
& "Le CLIENT ne doit pas tenter d’obtenir un accès non autorisé à l'application." & Chr(10) _
& "Le CLIENT doit utiliser l'application dans le strict respect du Contrat, de la législation et applicable." _
& "La possibilité offerte au CLIENT de faire une copie de sauvegarde, ne porte que sur une seule copie par application." _
& "Les macros vba sauvegardées restent la propriété de FP." _
& "Le CLIENT s’engage à prendre toutes dispositions pour que son personnel ne conserve pas de copie de l'application." & Chr(10) _
& "Il est interdit au CLIENT de copier ou reproduire l'application en dehors d’une telle copie de sauvegarde." _
& "Il est interdit au CLIENT de procéder à toute diffusion, commercialisation, à titre gratuit ou onéreux." & Chr(10) _
& "Veuillez confirmer par Oui ou Non", vbYesNoCancel + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
MsgBox "accepté"

Merci

Le 11/04/2022 à 11:43

Bonjour

C'est ce que fait "gestion du planning et des activités" une de mes applications.

A la première ouverture c'est la feuille "aide" qui s'ouvre afin d'expliquer comment elle fonctionne je crois.

Le principe : une cellule avec en donnée Vrai (pour réponse à : est ce la première ouverture ?) et lorsque les "droits" sont acceptés on passe la valeur à faux.

Le reste c'est de la cosmétique.

@ bientôt

LouReeD

Le 11/04/2022 à 18:52

Bonjour,

Je suis allé sur ton appli 'suivi des activités' mais je n'ai pas pu voir comment tu faisais, çà a beugué aprés encore un message sur de potentiels virus :

Mais c'est bon j'ai pu accéder à ton code..et çà çà m'intéresse vu les temps d'attente que j'ai pour générer les onglets:

    ' on masque la waitbox
    WaitBox.Hide
    WaitBox.Label2.Caption = "Veuillez patienter pendant le traitement. Merci."

Voilà sinon comment j'ai fait, çà marche mais la page des droits qui apparait est limitée en caractère et n'a que oui ou non en réponse.

Private Sub Worksheet_Activate()
Dim dat1 As Date, dat2 As Date, accept As Variant
If accept = False And MsgBox("Le CLIENT est responsable du respect du Contrat par les Utilisateurs Autorisés." _
& "Le CLIENT doit empêcher toute utilisation non autorisée de l'application Orienthur, et notifier sans délai à l'éditeur " _
& "FP toute utilisation non autorisée dont il aurait connaissance." & Chr(10) _
& "Le CLIENT ne doit pas tenter d’obtenir un accès non autorisé à l'application." & Chr(10) _
& "Le CLIENT doit utiliser l'application dans le strict respect du Contrat, de la législation et applicable." _
& "La possibilité offerte au CLIENT de faire une copie de sauvegarde, ne porte que sur une seule copie par application." _
& "Les macros vba sauvegardées restent la propriété de FP." _
& "Le CLIENT s’engage à prendre toutes dispositions pour que son personnel ne conserve pas de copie de l'application." & Chr(10) _
& "Il est interdit au CLIENT de copier ou reproduire l'application en dehors d’une telle copie de sauvegarde." _
& "Il est interdit au CLIENT de procéder à toute diffusion, commercialisation, à titre gratuit ou onéreux." & Chr(10) _
& "Veuillez confirmer par Oui ou Non", vbYesNoCancel + vbExclamation + vbDefaultButton2, "Titre") = vbYes Then
accept = True
End If
    dat1 = Now()
    ajout = 10 'Ajout de 10 jours
    dat2 = DateAdd("d", ajout, dat1)
If dat1 >= dat2 Then
MsgBox "La période d'essai se termine, Veuillez contacter l'éditeur. Merci."
Sheets("ecole").Activate
End If '

J'ai rien trouvé sur les droits d'auteur dans ton code.

Cdt

Le 11/04/2022 à 21:30

Bonsoir,

désolé, je crois bien que mes applications ne sont pas compatibles avec vous !
Ci joint un petit fichier "vite fait" pour vous montrer une des possibilité pour votre demande de mise en place d'un contrat pour utilisation :

8contrat-lrd.xlsm (19.94 Ko)

A voir si tout marche comme il le faut...

@ bientôt

LlouReeD

Le 12/04/2022 à 02:44

Merci pour ta réponse,

Cà bug sur ton fichier une fois que l'on accepte les termes du contrat.

Que quelqu'un d'autre confirme svp vu que nos Excel sont incompatibles

Cdt

Le 12/04/2022 à 07:01

C'est étrange ... J'ai essayé plusieurs fois...

@ bientôt

LouReeD

Le 12/04/2022 à 10:57

J'ai çà avant:

Le 12/04/2022 à 15:06

Bonjour,

Bon çà ne bug plus dans ce fichier, mais l'UF ne s'initialise pas.

Cdt

3orienthur-obf.xlsm (290.85 Ko)

Le 12/04/2022 à 18:52

Bonsoir,

un fichier, un USF avec un ou plusieurs label, une boite à cocher et deux boutons : Valider et Annuler, le code qui va avec :

' Code sur le module "ThiosWorkbook
Private Sub Workbook_Open()
    ' on masque le nom "LeContrat" sous Excel
    ActiveWorkbook.Names("LeContrat").Visible = False
    ' on teste si le contrat a été accepté lors d'une précédente ouverture
    If Evaluate(ActiveWorkbook.Names("LeContrat").Value) <> Application.UserName Then
        ' à l'ouverture on masque l'application
        Application.Visible = False
        ' on lance le USF d'acceptation de contrat
        Contrat.Show
        ' si à la fermeture du USF le contrat n'est pas accepté alors on quitte
        If Evaluate(ActiveWorkbook.Names("LeContrat").Value) <> Application.UserName Then Exit Sub
    End If
     ' on peut, à partir d'ici, continuer le déroulé des codes d'ouvertures
End Sub

' Code sur le USF
Dim Fin As Boolean

Private Sub Annuler_Click()
    ' on annule la procédure d'acceptation du contrat, on peut sortir du USF
   Fin = False
    ' on ferme le USF
    Unload Me
    ' on quitte l'application
    Application.Quit
End Sub

Private Sub CheckBox1_Click()
    ' si l'on coche ou décoche la boite à cocher alors le bouton "Valider" est actif ou inactif
    If CheckBox1 Then Valider.Enabled = True Else Valider.Enabled = False
End Sub

Private Sub UserForm_Initialize()
    ' on initialise Fin à True pour interdire la fermeture du USF par la croix
    Fin = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' on autorise de quitter le USF si FIN est à False
    Cancel = Fin
End Sub

Private Sub Valider_Click()
    ' on a validé l'acceptation du contrat, on peut sortir du USF
    Fin = False
    ' on inscrit la valeur de l’utilisateur qui a accepté le contrat dans le nom « LeContrat »
    ActiveWorkbook.Names("LeContrat").Value = Application.UserName
    ' on sauvegarde le classeur
    ThisWorkbook.Save
    ' on affiche l'application
    Application.Visible = True
    ' et on ferme le USF
    Unload Me
End Sub

Afin d'empêcher la distribution une fois le contrat accepté, la validation de cette acceptation est égale au nom de l'utilisateur de l'application : Application.UserName
Comme cela, chaque copie, pour chaque utilisateur devra accepter les termes du contrat... mais une fois accepté la version devient "personnel"...

@ bientôt

LouReeD

Le 12/04/2022 à 21:26

Bonsoir,

çà bug de partout.

J'ai renommé le userform par LeContrat, mais çà marche pas non plus. Idem en nouveau classeur.

Le 12/04/2022 à 21:41

ActiveWorkBook.Names permet d'accéder au "noms" sous Excel qui sont créés par le menu "formules" du ruban puis "gestionnaire des noms".

Créez un nom "LeContrat" en mettant 0 comme valeur puis validez et sortez.
le USF doit avoir comme nom celui qui est inscrit dans ThisWorkbook lors de son appel, donc :
pas comme cela :"J'ai renommé le userform par LeContrat" mais "contrat" car l'appel est contrat.Show.

@ bientôt

LouReeD

Le 12/04/2022 à 22:36

Bonsoir,

Je ne peux pas mettre de valeur à LeContrat dans gestionnaire de noms.

4contrat-droits-auteur2.xlsm (14.83 Ko)

Je ne peux pas annuler, et cocher donne un bug, mais c'est sûrement lié.

A+

Le 14/04/2022 à 22:23

Bonsoir,

le fichier téléchargé, s'ouvre (une fois les macros acceptées) sur le USF. Lors de la coche "accepter" le bouton "Valider" ne devient pas actif, le bouton "Annuler" n'est pas fonctionnel, en fait vous avez oubliez de mettre les codes VBA dans le USF...

@ bientôt

LouReeD

Le 14/04/2022 à 23:07

Bonjour,

effectivement.

Une fois que je l'ai rajouté, j'ai çà:

Et le plus ennuyeux, c'est que je ne peux ouvrir et aller sur la feuille excel pour y mettre le nom "LeContrat".

4contrat-droits-auteur2.xlsm (16.86 Ko)

Cdt

Le 14/04/2022 à 23:15

votre fichier en retour :

4contrat-droits-auteur2-2.xlsm (20.60 Ko)

Ce qu'il fallait voir c'est ceci : Valider.Enable = True, donc Valider est l'objet, car sur mon fichier j'ai changé le nom de mon bouton, en lieu et place de CommandButton1 dans la fenêtre de propriété catégorie Name, j'ai mis Valider.

Ensuite le "nom" LeContrat sous Excel est masqué afin qu'un utilisateur "lambda" ne puisse pas y accéder, pour que vous puissiez y accéder il faut mettre à True le Visible du WorkbookNames("LeContrat").Visible = True dans la procédure Open du classeur puis lancer cette même procédure avec la lecture sous VBA.

@ bientôt

LouReeD

Le 15/04/2022 à 00:02

Bon çà a fonctionné en mode utilisateur.

Mais quand je travaille sur un fichier ou il n'y a pas ton contrat çà se met à buguer en allant ouvrir un autre fichier ou il est. Tu as une explication ?

Pour info, j'ai eut des bugs persistants avec ton 1er fichier aprés avoir enlevé ton code, et j'avais fait en sorte de prendre une sauvegarde et de copier les macros dessus pour avoir un nouveau fichier sans bug. Mais là si çà recommence je vais finir par m'en passer.

Et si je veux que la page contrat s'ouvre pour un nouvel utilisateur, qu'est-ce que je dois changer ?

Merci