limitazione

Hai un problema con Excel?

Nuova discussione

limitazione
di Dodi (utente non iscritto) data: 07/11/2017 19:57:54
Buona sera a tutti
Chiedo se qualcuno può darmi una mano.
Allego il codice che non riesco a risolvere.
In pratica è un codice che limita l'utilizzo di un foglio excel.
Il problema che non riesco a risolvere, e son sicuro che qualcuno di voi saprà dove sbaglio.
In pratica con qsto codice imposto un periodo di utilizzo o prova del file, l'ho impostato anche in modo che se qualcuno retrocede anche una sola volta la data il file si blocca, e se rimette cmq la data del PC alla data corrente il file cmq non lo può più riutilizzare.
Insomma almeno mi sembra che ho creato una cosa simile.
Ora pero' dopo la premessa espongo il mio problema,
Ho fatto delle prove, anche senza retrodatare il pc, apro il file, e mi dice i giorni mancanti, lo chiudo provo a riaprirlo ma mi dice versione dimostrativa scaduta. Come posso risolvere qsto problema? Son sicuro che sarà una cavolata ma ho letto e riletto il codice ma mi sembra che sia corretto, non capisco dove sbaglio.

Grazie

Private Sub Demo30()
'=================================================
'=================================================
' protezione 30gg inizio

Dim iniziale As Date
Dim trascorsi As Integer
Dim restanti As Integer
Dim OGGI As Date
Dim ULTIMO_UTILIZZO As Date

' setta data primo utilizzo
If Sheets(2).Range("A1") = "" Then
Sheets(2).Range("A1") = Date
Sheets(2).Range("A2") = Date
iniziale = Date
Else
iniziale = Sheets(2).Range("A1")
End If



ULTIMO_UTILIZZO = Sheets(2).Range("A2")

' Memorizza data ODIERNA OGNI GIORNO
' SE LA DATA ODIERNA  E PRECEDENTE A QUELLA MEMORIZZATA IN "A2" ALLORA SI è RETRODATATO
If Date < ULTIMO_UTILIZZO Then
    For i = 1 To 4
    Beep
    Next i
    m = MsgBox("LA VERSIONE DIMOSTRATIVA E' SCADUTA" + vbNewLine + vbNewLine + "   CONTATTARE  l'autore del GESTIONALE" + vbNewLine + "   Email:lllllllllll", vbCritical)
    Application.Quit
Else
    OGGI = Now 'TUTTO OK
    Sheets(2).Range("A2") = OGGI
  
End If



' indica quanti giorni restano
' data odierna - data iniziale (A1)
trascorsi = OGGI - iniziale
restanti = 30 - trascorsi
If restanti > 0 Then
    m = MsgBox("HAI ANCORA " + CStr(restanti) + " GIORNI PER UTILIZZARE" + vbNewLine + "QUESTA VERSIONE DI VALUTAZIONE", vbInformation)
Else
    For i = 1 To 4
    Beep
    Next i
    m = MsgBox("LA VERSIONE DIMOSTRATIVA E' SCADUTA" + vbNewLine + vbNewLine + " CONTATTARE  l'autore del GESTIONALE" + vbNewLine + "   Email: llllllllll", vbCritical)
    Application.Quit
    
End If
End Sub

di Mister_x (utente non iscritto) data: 07/11/2017 23:47:46
ciao

devi memorizzare anche l'ora di controllo

' Memorizza data ODIERNA OGNI GIORNO
' SE LA DATA ODIERNA  E PRECEDENTE A QUELLA MEMORIZZATA IN "A2" ALLORA SI è RETRODATATO
If Date < ULTIMO_UTILIZZO Then
    For i = 1 To 4

' Memorizza data ODIERNA OGNI GIORNO
' SE LA DATA ODIERNA  E PRECEDENTE A QUELLA MEMORIZZATA IN "A2" ALLORA SI è RETRODATATO
If Now < ULTIMO_UTILIZZO Then  '''<<<<<---------
    For i = 1 To 4

di dodi (utente non iscritto) data: 07/11/2017 23:52:43
Cosa intendi con
devi memorizzare anche l'ora di controllo?

Puoi sistemarlo il codice.
Grazie
di Dodi (utente non iscritto) data: 07/11/2017 23:56:11
Ho riletto il codice.
E ti chiedo come mai devo registrare anche l'ora? Domanda non basta solo la data in formato dd,mm,yyyy?
Se puoi spiegarmelo in qualche modo così imparo cose nuove, grazie

E grazie per aver preso in considerazione la richiesta di aiuto
di Mister_x (utente non iscritto) data: 07/11/2017 23:56:43
ciao

devi cambiare da ( Date a Now )
da cosi If Date < ULTIMO_UTILIZZO Then a cosi If Now < ULTIMO_UTILIZZO Then
di Dodi (utente non iscritto) data: 08/11/2017 11:05:58
Grazie funziona
di linux (utente non iscritto) data: 08/11/2017 11:41:45
Il codice così com è presenta un problema che andrebbe risolto.
Prova a cambiare la data del pc. inserendo una data antecedente alla data inserita sul foglio 2 in cella A2 e vedi che succede....
di dodi (utente non iscritto) data: 08/11/2017 13:21:21
Ho provato si blocca ma se rimetto la data corrente ho notato che riprende a funzionare. Ma il mio intendo era quello che se uno cmq retrocede non voglio dargli modo dopo anche se rimette a posto il clendario di riutilizzarlo, voglio che '' venga punito'' con il non più utilizzo del foglio. Non mi piacciono i furbi, anche se penso che uno smanettone riesce cmq a baipassare la pasword che ho messo per accedere al Vba e al foglio nascosto.
Riesci a farmi una cosa simile che se '' il furbo'' retrocede la data e poi la rimette a posto non può più riutilizzare il foglio?
Penso che vada creata una routine che una volta chiuso il foglio nella cella A1 copia la data di A2 in modo che deve solo funzionare se uno lascia stare il calendario come da impostazione PC
Spero di esser stato chiaro

Grazie

di Mister_x (utente non iscritto) data: 08/11/2017 16:05:03
ciao

altro controllo in quella parte di sub()

ciao

If Now < ULTIMO_UTILIZZO Then
    For i = 1 To 4
    Beep
    Next i
    m = MsgBox("LA VERSIONE DIMOSTRATIVA E' SCADUTA" + vbNewLine + vbNewLine + "   CONTATTARE  l'autore del GESTIONALE" + vbNewLine + "   Email:lllllllllll", vbCritical)
    Sheets(2).Range("A2") = DateSerial(2900, 1, 1)
    ActiveWorkbook.Save
    Application.Quit
Else
    OGGI = Now 'TUTTO OK
    Sheets(2).Range("A2") = OGGI
  
End If

di linux (utente non iscritto) data: 08/11/2017 16:16:33
Option Explicit
Private Sub Workbook_Open()

Dim DataOK, DataScadenza, Datainserita

Sheets(2).Range("A1") = Date ' copia data odierna del pc
Sheets(2).Range("A2") = #11/5/2017# ' selezioniamo il foglio 2 e trasportiamo la data di scadenza in A2. _
inseriamo la data di scadenza nel modo mese, giorno, anno
If Sheets(2).Range("A2").Value > Sheets(2).Range("A1") Then

DataScadenza = Sheets(2).Range("A2").Value
DataOK = Date
MsgBox "Puoi utilizzarlo per " & DataOK - DataScadenza & " giorno/i"
Else
MsgBox "Versione Scaduta. Per aggiornamenti, o uleriore proroga, rivolversi al gestionale!", vbExclamation, "Versione scaduta..."

' se si vuole possiamo dare un ulteriore periodo di prova impostato a 10 giorni
Dim x, g, h
h = Sheets(2).Range("A1").Value
g = Sheets(2).Range("A2").Value + 10
x = InputBox("Scrivi la Password ( linux )per usare il software per altri 10 giorni", "E' richiesta una Password!!!")

If x <> "linux" Or g < h Then
MsgBox "Non hai inserito la Password corretta. Oppure tempo massimo scaduto." & Chr(13) & "Chiusura File in corso....", vbExclamation, "Password errata"

MsgBox "Tempo di utilizzo esaurito. Chiudo excel"

Application.Quit
ThisWorkbook.Close savechanges:=False
Else
' inserisci cosa fare se la password è giusta
MsgBox "Password corretta!", vbInformation, "Accesso consentito..."

' inserire cosa fare ad esempio l'apertura di un form
UserForm1.Show
End If
End If

End Sub
Ciao mister. io l'ho pensato diverso e semplificato credo. Può andare? ciaux
di Mister_x (utente non iscritto) data: 08/11/2017 16:33:58
ciao Linux

penso che tutto questo sia per studio di utilizzo di VBA, quindi tutto quello che viene proposto serve
per capire il funzionamento di questi
se questo invece serve proprio per una limitazione del programma , mi dispiace dirlo ma e' un lavoro molto INUTILE al contesto
in quanto e' bipassabile in qualsiasi momento da una che capisca un pochino Excel e l'utilizzo di questi
addirittura con le Pass o altri marchingegni
comunque io mi sono limitato ad inserire un qualche cosa nella sub() senza stravolgere il tutto, roba da un paio di minuti

ciao
di dodi (utente non iscritto) data: 08/11/2017 19:25:01
Ciao mister
Ho testato la tua modifica è funziona,
Ringrazio anche Linux per la sua soluzione, la testerò in qsti giorni e vedo come funziona.
E mi riallaccio al discorso di chi è in grado di scardinare le password, non lo metto in dubbio che ci sono cervelli capaci.
Faccio cmq presente che il codice che ho creato ha qsta funzione:
Mostra il tempo residuo di prova e subito dopo lancia una user con il login,
Poi il foglio 2 e nascosto e protetto con pasword e inoltre l'accesso al Vba e anch'esso protetto. Insomma ci vuole un po' di impegno.

Grazie per le soluzioni.
di Dodi (utente non iscritto) data: 09/11/2017 10:21:25
Mi rivolgo a Linux, visto che ha proposto un'ulteriore soluzione.
Ho testato il tuo codice è lo trovo interessante,
In pratica può essere utile per dare ulteriore possibilità di utilizzo.
Ho visto che terminato il primo periodo di prova e per usufruire della proroga il codice va riattivato con una password. E fin qui tutto ok.
Ma se chiudo il file è lo riavvio mi riappare la maschera che mi dice periodo di prova ecc ecc e si apre la maschera per la psw
. Ora io dicevo, è possibile che una volta data la psw per l'estensione riattiva la procedura senza richiedere sempre la psw? E una volta finito il periodo di estensione si blocca?
Spero di esser stato chiaro.
La tua soluzione può tornarmi utile.

Grazie
di Dodi (utente non iscritto) data: 09/11/2017 15:55:51
Ciao Mister

Scusa se ti rompo le scatole, ti volevo chiedere un piacere se puoi, visto che mi sei stato di grande aiuto fin ora.

Sul mio codice che mi hai sitemato,
In pratica quando finisce il periodo di prova
Esce l'avviso che dice che il periodo di prova e terminato ecc ecc.. e fin qui tutto ok.
Però cliccando su ok dell 'avviso esce un avviso di ;
errore di run-time'6':
Overflow

E possibile togliere qst'errore?
In pratica sarebbe meglio che dopo l'avviso di fine prova uno cliccando sul tasto ok si chiude excel senza errore.
Sicuramente sarà una cavolata che io non so risolvere.

Se è possibile ti ringrazio

di linux (utente non iscritto) data: 09/11/2017 21:38:20
prova questo

Option Explicit
Private Sub Workbook_Open()
'Sheets("Foglio2").Visible = False  ' nascondiamo il foglio2
'Sheets(1).Select
Dim DataOK, DataScadenza, Datainserita

Sheets(2).Range("A1") = Date ' copia data del pc sul foglio2 cella A1
Sheets(2).Range("A2") = #11/5/2017# ' selezioniamo il foglio 2 e trasportiamo la data di scadenza in A2. _
                                      inseriamo la data di scadenza nel modo mese, giorno, anno

Sheets(2).Range("A4") = 10  ' copia sul foglio il nemero 10 che sarebbero i giorni di ulteriore utilizzo
If Sheets(2).Range("A2").Value > Sheets(2).Range("A1") Then

DataScadenza = Sheets(2).Range("A2").Value
DataOK = Date
MsgBox "Puoi utilizzarlo per " & DataOK - DataScadenza & " giorno/i"
Else
MsgBox "Versione Scaduta. Per aggiornamenti, o uleriore proroga, rivolversi al gestionale!", vbExclamation, "Versione scaduta..."


' se si vuole possiamo dare un ulteriore periodo di prova impostato in 10 giorni
Dim x, g, h
h = Sheets(2).Range("A1").Value
g = Sheets(2).Range("A2").Value + 10  ' data scadenza + 10 gg

If Sheets(2).Range("A6") < Sheets(2).Range("A1") Then  ' verifica che la data inserita sul foglio2 cella A6 sia minore di A1 _
                                                        se così è allora chiudi tutto...

MsgBox "anche la proroga è scaduta. Contattare il gestionale!!!"
Application.Quit
ThisWorkbook.Close savechanges:=False


End If


x = InputBox("Scrivi la Password ( linux ) per usare il software per altri 10 giorni", "E' richiesta una Password!!!")

If x <> "linux" Or g < h Then
MsgBox "Non hai inserito la Password corretta. Oppure tempo massimo scaduto." & Chr(13) & "Chiusura File in corso....", vbExclamation, "Password errata"

MsgBox "Tempo di utilizzo esaurito. Chiudo excel"

Application.Quit
ThisWorkbook.Close savechanges:=False
Else
' inserisci cosa fare se la password è giusta
MsgBox "Password corretta!", vbInformation, "Accesso consentito..."


' inserire cosa fare ad esempio l'apertura di un form
UserForm1.Show
End If
End If

End Sub

di Dodi (utente non iscritto) data: 09/11/2017 21:56:24
Ciao linux
Nel tuo codice ho notato anche un'altra cosa, se uno retrodata il calendario i giorni si rigenerano. E possibile anche sistemarlo che se uno retrodata si blocca x sempre? Anche se uno poi rimette il calendario a suo posto?

Grazie
di Dodi (utente non iscritto) data: 10/11/2017 09:16:10
Buon giorno linux

Ho appena testata la tua soluzione, penso che ci sia un problema,
Te l'hai testata?
In pratica quando finisce il periodo di prova, subito dopo appare il msg
Che dice : anche il periodo di proroga e scaduta,
In pratica non fa partire la richiesta di proroga.
Gli puoi dare un occhio. E magari verifichi anche che se uno retrodata il calendario del pc. Vorrei che si bloccasse per sempre, senza concedere proroghe o altro modo. Magari rimettendo il calendario al suo posto.
Insomma se gentilmente me lo riguardi.
Trovo interessante il fatto di dare la proroga.

Grazie anticipatamente e buona giornata
di Dodi (utente non iscritto) data: 10/11/2017 12:12:02
Scrivo a Mister

Ti avevo chiesto se era possibile togliere l'errore
Run time'6'

Dopo vari tentativi son riuscito ad eliminarlo.

Ti ringrazio cmq per l'aiuto e la soluzione precedente.
di linux (utente non iscritto) data: 10/11/2017 20:35:19
Non l'ho testata. La testerò appena avrò un pò tempo.
Però devo dire che visto che sei riuscito a risolvere il problema al codice di misterx perchè non lo condividi qui? Non ti sembra che altre persone come te potrebbero essere interessate?
grazie per l'attenzione.......
Ciaux
di dodi (utente non iscritto) data: 10/11/2017 20:51:20
Lo pubblico domani.

Così al servizio di tutti.

E grazie per il consiglio è per quando sarà pronto il tuo codice.

di Dodi (utente non iscritto) data: 11/11/2017 11:08:37
Buon giorno a tutti.
Come da giusto suggerimento di Linux Posto il codice completo per periodo di prova e con blocco totale se si retrocede la data del pc.
Ringrazio anche mister per il suo aiuto che ha contribuito al completamento.

Private Sub demo30()
'=================================================
'=================================================
' protezione 30gg inizio

Dim iniziale As Date
Dim trascorsi As Integer
Dim restanti As Integer
Dim OGGI As Date
Dim ULTIMO_UTILIZZO As Date

' setta data primo utilizzo
If Sheets(2).Range("A1") = "" Then
Sheets(2).Range("A1") = Date
Sheets(2).Range("A2") = Date
iniziale = Date
Else
iniziale = Sheets(2).Range("A1")
End If



ULTIMO_UTILIZZO = Sheets(2).Range("A2")

' Memorizza data ODIERNA OGNI GIORNO
' SE LA DATA ODIERNA  E PRECEDENTE A QUELLA MEMORIZZATA IN "A2" ALLORA SI è RETRODATATO
If Now < ULTIMO_UTILIZZO Then
    For I = 1 To 4
    Beep
    Next I
    m = MsgBox("LA VERSIONE DIMOSTRATIVA E' SCADUTA" + vbNewLine + vbNewLine + "   CONTATTARE  l'autore del GESTIONALE" + vbNewLine + "   Email: pincopallino@libero.it ", vbCritical)
    Sheets(2).Range("A2") = DateSerial(2900, 1, 1)
    ThisWorkbook.Save
    ThisWorkbook.Close
    Application.Quit
Else
    OGGI = Now 'TUTTO OK
    Sheets(2).Range("A2") = OGGI
  
End If



' indica quanti giorni restano
' data odierna - data iniziale (A1)
trascorsi = OGGI - iniziale
restanti = 30 - trascorsi    <=============================== Modifica il 30 e mettere i giorni che uno vuole impostare come periodo di prova
If restanti > 0 Then
    m = MsgBox("HAI ANCORA " + CStr(restanti) + " GIORNI PER UTILIZZARE" + vbNewLine + "QUESTA VERSIONE DI VALUTAZIONE", vbInformation)
Else
    For I = 1 To 4
    Beep
    Next I
    m = MsgBox("LA VERSIONE DIMOSTRATIVA E' SCADUTA" + vbNewLine + vbNewLine + " CONTATTARE  l'autore del GESTIONALE" + vbNewLine + "   Email: pincopallino@libero.it", vbCritical)
   ThisWorkbook.Save
   ThisWorkbook.Close
   Application.Quit
    
End If

'=================================================
'=================================================
' protezione 30gg FINE




End Sub
Private Sub UserForm_Initialize()
demo30    '<===================================== SE SI METTE L'APICE DAVANTI A DEMO30 SI DISATTIVA IL CODICE SENZA CANCELLARLO DAL WORKBOOK
Application.Visible = False
End Sub

di Dodi (utente non iscritto) data: 13/11/2017 12:38:42
Buon giorno
Linux
Chiedevo se avevi avuto modo di testare il tuo codice.
E come vedi è se ti può servire ho allegato anche il mio codice.
Magari prendi spunto e completi il tuo.

Resto in attesa del tuo codice modificato e funzionante. Perché come detto mi trona utilissimo per la mia necessità.

Grazie

Vuoi Approfondire?