Ciao,
Ho un programma in excel da far partire solamente inserendo determinati codici da 4 cifre, ad esempio
0099
0098
0056
0409
7455
etc.
Come posso fare?
Ciao e grazie.
Moderatori: Anthony47, Flash30005
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$8" Then pippo
End Sub
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Private Sub Workbook_Open()
Dim NUtente(5), Codice(5)
Dim sBuffer As String
Dim lSize As Long
sBuffer = Space(255)
lSize = Len(sBuffer)
Call GetUserName(sBuffer, lSize)
Utente = UCase(Left(Trim(sBuffer), 10))
colu = 0
Dim ut As String
Do
colu = colu + 1
If Mid(Utente, colu, 1) = Chr(0) Then Exit Do
ut = ut & Mid(Utente, colu, 1)
Loop
Utente = Trim(ut)
Accesso = 0
NUtente(1) = "AAAA" '<<<< Nome del 1° utente che potrà aprire il foglio
NUtente(2) = "BBBB" '<<< etc
NUtente(3) = "CCCC"
NUtente(4) = "DDDD"
NUtente(5) = "EEEE"
Codice(1) = "0001" '<<<<< Codice del 1° utente che potrà aprire il foglio
Codice(2) = "0002" '<<< etc
Codice(3) = "0003"
Codice(4) = "0004"
Codice(5) = "0005"
For I = 1 To 5
If Utente = NUtente(I) Then
Accesso = 1
Exit For
End If
Next
If Accesso = 1 Then
Dim Message, Title, Default, MyValue
Message = "Inserire Codice" ' Imposta il messaggio.
Title = "Apertura Foglio" ' Imposta il titolo.
Default = "xxxx" ' Imposta il valore predefinito. '<<< puoi togliere le xxxx e lasciare vuoto con ""
MyValue = InputBox(Message, Title, Default) ' Visualizza il messaggio, il titolo e il valore predefinito.
End If
On Error GoTo salta
If Accesso = 1 And Codice(I) = MyValue Then
MsgBox "Codice Corretto"
Exit Sub
Else
salta:
MsgBox "Codice Errato" '<<<< messaggio che puoi togliere per evitare che l'uitente non autorizzato intervenga bloccando la macro
On Error GoTo 0
Workbooks("Cartel1.xls").Close SaveChanges:=False '<<<< Nome del file di excel
End If
End Sub
Private Sub Workbook_Open()
Dim NUtente(5), Codice(5) '<<<< aumentare la variante 5 al vettore (Nutente, Codice) in funzione degli utenti
Dim MessageU, Title, Default, MyValueU
MessageU = "Utente" ' Imposta il messaggio.
TitleU = "Riconoscimento Utente" ' Imposta il titolo.
DefaultU = "" ' Imposta il valore predefinito.
MyValueU = InputBox(MessageU, TitleU, DefaultU) ' Visualizza il messaggio, il titolo e il valore predefinito.
Accesso = 0
NUtente(1) = "AAAA"
NUtente(2) = "BBBB"
NUtente(3) = "CCCC"
NUtente(4) = "DDDD"
NUtente(5) = "EEEE"
Codice(1) = "0001"
Codice(2) = "0002"
Codice(3) = "0003"
Codice(4) = "0004"
Codice(5) = "0005"
For I = 1 To 5 '<<<< aumentare la variante 5 in funzione degli utenti
If MyValueU = NUtente(I) Then
Accesso = 1
Exit For
End If
Next
If Accesso = 1 Then
Message = "Inserire Codice" ' Imposta il messaggio.
Title = "Apertura Foglio" ' Imposta il titolo.
Default = "xxxx" ' Imposta il valore predefinito.
MyValue = InputBox(Message, Title, Default) ' Visualizza il messaggio, il titolo e il valore predefinito.
End If
On Error GoTo salta
If Accesso = 1 And Codice(I) = MyValue Then
' MsgBox "Codice Corretto"
Exit Sub
Else
salta:
MsgBox "Codice Errato" '<<< commentare solo quando la macro è stata messa a punto (e se si ricordano Nomi e Codici abbinati - SI RISCHIA DI NON APRIRE PIU' IL FILE)
On Error GoTo 0
'Workbooks("Utente2.xls").Close savechanges:=False '<<< Togliere il commento se ci sono altri fogli aperti
ActiveWorkbook.Save '<<<< commentare questo codice se ci sono altri fogli aperti - Abbinato al codice sottostante
Application.Quit '<<<< commentare questo codice se ci sono altri fogli aperti - Chiude l'applicativo Excel
End If
End Sub
Public MyValueU As String
Torna a Applicazioni Office Windows
[EXCEL] controllo corrispondenza tra valori con un vincolo Autore: sbs |
Forum: Applicazioni Office Windows Risposte: 9 |
Visitano il forum: Nessuno e 28 ospiti