| | Post: 651 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
  14/03/2017 19:52 | |
Ciao a tutti.
E' possibile creare una macro che faccia questo?:
Avvio excel se la macro vede che la data è scaduta domanda una password.
Per la data intendo per esempio 31/12/2017
se non viene inserita la password esatta il workbook si chiude.
Ho trovato in rete qualcosa di simile:
Option Explicit
Private Sub Workbook_Open()
Dim MyDate As Date
Dim Pword As String, response As String
MyDate = DateValue("31/12/2017")
If Date < MyDate Then
Pword = "MyPass"
End If
response = InputBox("Enter Password to continue", "Password")
If response <> Pword Then
Application.DisplayAlerts = False
ThisWorkbook.Close
End If
end sub
ma deve funzionare solo dopo il 31/12/2017
xam [Modificato da xam99 14/03/2017 23:37] -------------------------------
excel 2003 ufficio / 2007 casa |
|
| | Post: 1.972 | Registrato il: 21/03/2008
| Città: LOCATE VARESINO | Età: 76 | Utente Veteran | 2007 / 13 | | OFFLINE | |
|
| 15/03/2017 00:20 | |
ciao
inserimento di un If in un primo If controllo data
Option Explicit
Private Sub Workbook_Open()
Dim MyDate As Date
Dim Pword As String, response As String
MyDate = DateValue("31/12/2017")
If Date > MyDate Then
Pword = "MyPass"
response = InputBox("Enter Password to continue", "Password")
If response <> Pword Then
Application.DisplayAlerts = False
ThisWorkbook.Close
End If
End If
End Sub
Ciao da locate
excel 2007 / 13 |
| | Post: 651 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 15/03/2017 12:45 | |
Ciao
Penso ci sia un errore:
Dopo l'inserimento della password > ok
il workbook si chiude.
xam -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 1.092 | Registrato il: 10/10/2013
| Città: VICENZA | Età: 69 | Utente Veteran | 365 | | OFFLINE |
|
| 15/03/2017 13:10 | |
ciao
funziona bene
non è che sbagli pass
l'ho provata al activate di un foglio
e va benissimo |
| | Post: 652 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 15/03/2017 13:47 | |
Infatti errore mio, la macro è ok!
Ciao
xam -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 653 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 15/03/2017 19:14 | |
La macro è ok, è possibile inserire una modifica?
scadenza = ogni 1 mese
ad inserimento esatto della password il workbook funziona fino a 1 del prossimo mese.
la macro:
Option Explicit
Private Sub Workbook_Open()
Dim MyDate As Date
Dim Pword, response, avviso As String
MyDate = DateValue("31/12/2016")
If Date > MyDate Then
Pword = "ciaomax" & Date
'response = InputBox("Enter Password to continue", "Password")
response = InputBox("Sign. " & Environ("UserName") & Chr(13) & _
"password scaduta!" & Chr(13) & _
"inserisci la nuova password" & Chr(13) & _
"se non inserita o errata il workbook verrà chiuso!!!", "PASSWORD")
If response <> Pword Then
Application.DisplayAlerts = False
avviso = MsgBox("Sign. " & Environ("UserName") & Chr(13) & _
"password errata o non inserita," & Chr(13) & _
"il workbook verrà chiuso!!!", vbCritical + vbOKOnly, "ERRORE!")
ThisWorkbook.Close
End If
End If
End Sub
xam -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 654 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 15/03/2017 20:14 | |
Ciao,
così è per il primo del mese?
MyDate = DateSerial(Year(Date), Month(Date), 1) '<<< 1 = primo del mese
Option Explicit
Private Sub Workbook_Open()
Dim MyDate As Date
Dim Pword, response, avviso As String
'MyDate = DateValue("31/12/2016") '<<< data fissa
MyDate = DateSerial(Year(Date), Month(Date), 1) '<<< 1 = primo del mese
If Date > MyDate Then
Pword = "ciaomax" & Date
'response = InputBox("Enter Password to continue", "Password")
response = InputBox("Sign. " & Environ("UserName") & Chr(13) & _
"password scaduta!" & Chr(13) & _
"inserisci la nuova password" & Chr(13) & _
"se non inserita o errata il workbook verrà chiuso!!!", "PASSWORD")
If response <> Pword Then
Application.DisplayAlerts = False
avviso = MsgBox("Sign. " & Environ("UserName") & Chr(13) & _
"password errata o non inserita," & Chr(13) & _
"il workbook verrà chiuso!!!", vbCritical + vbOKOnly, "ERRORE!")
ThisWorkbook.Close
End If
End If
End Sub
se la data del 1° mese è esatta è possibile dopo l'inserimento esatto della password che funzioni tutto fino al 1° del mese successivo?
xam [Modificato da xam99 15/03/2017 20:19] -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 655 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 16/03/2017 18:02 | |
Ciao,
ho modificato un pò la macro.
Ora funziona dalla data inserita qui:
ExpirationDate = DateValue("01/02/2017")
la macro:
Option Explicit
Private Sub Workbook_Open()
ExpirationCode
End Sub
Sub ExpirationCode()
Dim ExpirationDate As Date
Dim response, avviso, messaggio, Pword, username As String
ExpirationDate = DateValue("01/02/2017")
If Now() >= ExpirationDate Then
messaggio = MsgBox("Sign." & Environ("UserName") & Chr(13) & "Trial Period scaduto il " & CStr(ExpirationDate) & Chr(13) & _
"per continuare inserisci una nuova password!", vbCritical + vbOKOnly, "AVVISO!")
username = Environ("UserName")
'Pword = "ciaomax" & Date
Pword = username & Date
response = InputBox("Sign. " & Environ("UserName") & Chr(13) & _
"inserisci la nuova password" & Chr(13) & _
"se non inserita o errata il workbook verrà chiuso!!!", "PASSWORD")
If response <> Pword Then
Application.DisplayAlerts = False
avviso = MsgBox("Sign. " & Environ("UserName") & Chr(13) & _
"password errata o non inserita," & Chr(13) & _
"il workbook verrà chiuso!!!", vbCritical + vbOKOnly, "ERRORE!")
'ThisWorkbook.Close
ThisWorkbook.Close savechanges:=False
End If
End If
End Sub
ora se possibile chiedo un aiuto per fare questo:
dopo l'inserimento della password il workbook deve funzionare fino al 1° giorno del mese successivo per richiedire di nuovo la password
Un saluto e grazie in anticipo.
xam -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 656 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 16/03/2017 20:21 | |
Ciao penso che la modifica da fare sia qualcosa di simile a questo:
se la password è esatta questo deve aumentare di 1 mese
MyDate = DateValue("01/03/2017")
se password è sbagliata il workbook si chiude.
xam -------------------------------
excel 2003 ufficio / 2007 casa |
| | Post: 657 | Registrato il: 18/02/2010
| Città: MILANO | Età: 28 | Utente Senior | excel 2003 / 2007 | | OFFLINE | |
|
| 16/03/2017 22:04 | |
Ciao
ho modificato la macro ma non riesco a modificare qui:
dopo l'inserimento della password esatta la cella A1 deve aumemtare di 1 mese.
la macro:
Option Explicit
Private Sub WorkBook_Open()
ExpirationCode
End Sub
Sub ExpirationCode()
Dim ExpirationDate As Date
Dim response, avviso, messaggio, Pword, username, valore As String
'ExpirationDate = DateValue("01/02/2017")
ExpirationDate = DateValue(Range("A1"))
If Now() >= ExpirationDate Then
messaggio = MsgBox("Sign." & Environ("UserName") & Chr(13) & "Trial Period scaduto il " & CStr(ExpirationDate) & Chr(13) & _
"per continuare inserisci una nuova password!", vbCritical + vbOKOnly, "AVVISO!")
username = Environ("UserName")
'Pword = "ciaomax" & Date
Pword = username & Date
response = InputBox("Sign. " & Environ("UserName") & Chr(13) & _
"inserisci la nuova password" & Chr(13) & _
"se non inserita o errata il workbook verrà chiuso!!!", "PASSWORD")
If response = Pword Then
'>>>>> qui la cella A1 deve aumentare di 1 mese <<<<<
MsgBox "ciao"
Else
If response <> Pword Then
Application.DisplayAlerts = False
avviso = MsgBox("Sign. " & Environ("UserName") & Chr(13) & _
"password errata o non inserita," & Chr(13) & _
"il workbook verrà chiuso!!!", vbCritical + vbOKOnly, "ERRORE!")
'ThisWorkbook.Close
ThisWorkbook.Close savechanges:=False
End If
End If
End If
End Sub
allego esempio.
xam -------------------------------
excel 2003 ufficio / 2007 casa |
|
|
|
|