Ho uno strano comportamento tra form
L'applicazione si apre con la verifica delle credenziali nella frmlogin. Se corette eseguo unload della frmlogin e show della frmmain. Nella function activate eseguo alcuni controlli e abilito la maschera editando i dati dell'utente loggato.
Se debbo chiudere la formain con la classica X, eseguendo la function UserForm_Terminate nella quale eseguo la unload della formmain e frmlogin.show, effettuo il nuovo login nella frmlogin in maniera regolare ritornando alla frmmain
NON sono più eseguite in maniera corretta le istruzioni della function UserForm_ActivateHo evidenziato nel .doc allegato le istruzioni che, pur essendo eseguite senza errori, non producono l'effetto voluto.
Sperando di non creare disagio, allego anche in forma zippata la cartella con i dati per una esecuzione dell'applicazione.
Due giorni che ci batto la testa contro il muro; Non mi sto capacitando sul motivo di tale banalissima anomalia.
Grazie
Moreno
Non potendo allegar file o documenti per maggiormente chiarire il problema, riporto le function utilizzate nelle due form
Credenziali da inserire User_id admin e Password password
Viene verificato l’utente eseguito unload della form e eseguito show della frmmain
In questa form la activate esegue alcuni controlli e visualizza il nome dell’utente abilitando i bottoni in funzione del profilo. Se chiudo la maschera con la X ritornando alla frmlogin
Imposto delle nuove credenziali User_id wr1049 e Password password
viene rieseguito il controllo sulle credenziali sul nuovo utente,
eseguito unload della form e eseguito show della frmmain
, ma poi le istruzioni della frmmain richiamata, anche se eseguite non vengono attualizzate.
Sto diventando pazzo non capendo il motivo del non corretto funzionamento.
Allego il codice delle due form
Frmlogin <------ form chiamante
Dim CaptionForm As String
Public StatoUser As String
Public utenteAbilitato As Boolean
Private Sub CB_Annulla_Click()CaptionForm = NomeApplicazione & " Login"
MsgBox "Operazione annullata dall'Utente", vbExclamation, CaptionForm
Me.Hide
If AbilitationUser <> -1 Then
ThisWorkbook.Close saveChanges
End If
End Sub
Private Sub CB_Conferma_Click()Dim Risp As Variant
CaptionForm = NomeApplicazione & " Login"
If Not GM_CampiFormRegolari Then
Risp = MsgBox(MessErrore, vbCritical, CaptionForm)
Select Case IndCampo
Case 1
frmLogin.txt1.SetFocus
Case 2
frmLogin.Txt2.SetFocus
Case 3
frmLogin.txt3.SetFocus
End Select
Exit Sub
Else
If GM_CredenzialiinErrore(frmLogin.txt1.Value, frmLogin.Txt2.Value) Then
LabelMsg = MessErrore
IndCampo = 1
Exit Sub
Else
Select Case CheckBox1.Value
Case True
ModificaPassword
Risp = MsgBox("Utente abilitato " & vbCrLf & _
"Password Modificata con successo", vbInformation, CaptionForm)
Case False
MsgBox "Utente Abilitato", vbInformation, CaptionForm
End Select
Unload Me
frmMain.Show
End If
End If
End Sub
Function GM_CampiFormRegolari()Dim Indice As Integer
Dim MaxField As Integer
Dim CampoInAnalisi As String
GM_CampiFormRegolari = False
Indice = 0
MaxField = 2
' campo user_iD
If txt1.Value = "" Or IsNull(txt1.Value) Then
MessErrore = "User_ID non valorizzata"
IndCampo = 1
Exit Function
End If
If txt1.Value = "Inserire User_ID" Then
MessErrore = "Inserisci la User_id"
IndCampo = 1
Exit Function
End If
' campo Password
If Txt2.Value = "" Or IsNull(Txt2.Value) Then
MessErrore = "Password non valorizzata"
IndCampo = 2
Exit Function
End If
If Txt2.Value = "Inserire la Password" Then
MessErrore = "Inserisci la Password"
IndCampo = 2
Exit Function
End If
Select Case CheckBox1.Value
Case True
' campo Nuova Password
If txt3.Value = "" Or IsNull(txt3.Value) Then
MessErrore = "Nuova Password non valorizzata"
IndCampo = 3
Exit Function
End If
If txt3.Value = Txt2.Value Then
MessErrore = "La nuova Password deve essere diversa dalla Password in uso"
IndCampo = 3
Exit Function
End If
If Len(txt3) > 15 Then
MessErrore = "La nuova Password non deve superare i 15 caratteri"
IndCampo = 3
Exit Function
End If
End Select
GM_CampiFormRegolari = True
End Function
Function GM_CredenzialiinErrore(UserId, PwdUtente)GM_CredenzialiinErrore = True
Dim Strsql As String
Dim Parametro As String
Dim Miofoglio As String
Dim UtenteLoggato As String
Dim rs1 As ADODB.Recordset
Dim Prog As Integer
Parametro = "A"
Strsql = "SELECT AnaDip.Matricola_Dip, AnaDip.Cognome_Dip, AnaDip.Nome_Dip, AnaDip.UserLevel " & _
" FROM AnaDip " & _
" WHERE (((AnaDip.User_Id_Dip)='" & frmLogin.txt1 & "') AND ((AnaDip.Password_Dip)='" & PwdUtente & "'))"
Set rs1 = oConn.Execute(Strsql)
If Not rs1.EOF Then
frmLogin.LabelUtente = rs1("Cognome_Dip") & " " & rs1("Nome_Dip")
NameUser = rs1("Cognome_Dip") & " " & rs1("Nome_Dip")
NameOper = rs1("Cognome_Dip")
UserLogged = rs1("Matricola_Dip")
LabelMsg = "Utente Abilitato"
AbilitationUser = rs1("UserLevel")
FilialeUser = FilialeActualUse(rs1("Matricola_Dip"))
Select Case CheckBox1.Value
' verifico se ho impostato user_id = a Password
Case False
If UCase(UserId) = UCase(PwdUtente) Then
MessErrore = "Eseguire il Cambio Password prima di procedere con il login "
GM_CredenzialiinErrore = True
Exit Function
End If
End Select
Select Case rs1("UserLevel")
Case 0
MessErrore = "Utente Non Abilitato"
GM_CredenzialiinErrore = True
Exit Function
Case Else
End Select
Else
frmLogin.LabelUtente = " "
NameUser = ""
MessErrore = "Utente Inesistente"
LabelMsg = "Utente Inesistente"
GM_CredenzialiinErrore = True
Exit Function
End If
Set rs1 = Nothing
GM_CredenzialiinErrore = False
End Function
Private Function UtenteLog(UserId As String)Dim Strsql As String
Dim Parametro As String
Dim rs1 As ADODB.Recordset
Dim Prog As Integer
GM_ConnMDB
Strsql = "SELECT AnaDip.Matricola_Dip, AnaDip.Cognome_Dip, AnaDip.Nome_Dip, AnaDip.Stato " & _
" FROM AnaDip " & _
" WHERE (((AnaDip.User_Id_Dip)='" & frmLogin.txt1 & "'))"
Set rs1 = oConn.Execute(Strsql)
If Not rs1.EOF Then
UtenteLog = rs1("Cognome_Dip") & " " & rs1("Nome_Dip")
StatoUser = rs1("Stato")
Else
UtenteLog = " * Inesistente * "
Me.Label_Profilo.Caption = ""
End If
rs1.Close
Set rs1 = Nothing
End Function
Private Function FilialeActualUse(MatricolaUser As Integer)Dim Strsql As String
Dim Parametro As String
Dim rs1 As ADODB.Recordset
Dim Prog As Integer
Strsql = "SELECT PDL.UtenteActual, CDC.FILIALE_CDC " & _
" FROM PDL INNER JOIN CDC ON PDL.CDC = CDC.C_CDC " & _
" WHERE (((PDL.UtenteActual)=" & MatricolaUser & "))"
Set rs1 = oConn.Execute(Strsql)
If Not rs1.EOF Then
FilialeActualUse = rs1("FILIALE_CDC")
Else
FilialeActualUse = 0
End If
rs1.Close
Set rs1 = Nothing
End Function
Private Sub CheckBox1_Click()Me.Label_NewPassword.Visible = CheckBox1.Value
Me.txt3.Visible = CheckBox1.Value
End Sub
Private Sub txt1_Exit(ByVal Cancel As MSForms.ReturnBoolean)If txt1.Value <> "" Then
frmLogin.LabelUtente = UtenteLog(txt1)
Me.CB_Conferma.Enabled = False
utenteAbilitato = False
Select Case StatoUser
Case "B"
Me.LabelMsg = "Utente Bloccato - Richiedere abilitazione ad Amministratore"
Exit Sub
Case "E"
Me.LabelMsg = "Utente Estinto - Richiedere abilitazione ad Amministratore"
Exit Sub
Case "A"
Me.CB_Conferma.Enabled = True
utenteAbilitato = True
Me.LabelMsg = ""
Case Else
Me.LabelMsg = "Utente in stato indefinito - Operatività non abilitata"
Exit Sub
End Select
End If
End Sub
Private Sub txt2_Exit(ByVal Cancel As MSForms.ReturnBoolean)If Not utenteAbilitato Then
Exit Sub
End If
Select Case Me.CheckBox1.Value
Case True
Me.txt3.SetFocus
Exit Sub
Case Else
Me.CB_Conferma.SetFocus
End Select
End Sub
Private Sub UserForm_Activate()Me.Caption = NomeApplicazione
Me.txt1.SetFocus
CheckBox1.Value = True
CheckBox1.Value = False
If Not CaricatiParametri Then
MsgBox MessErrore, vbCritical, NomeApplicazione
Else
GM_ConnMDB
End If
End Sub
Private Sub UserForm_Terminate()End Sub
Private Sub ModificaPassword()Dim Strsql As String
Strsql = "UPDATE ANADIP SET " & _
" AnaDip.Password_Dip = '" & txt3 & "' " & _
" WHERE (((AnaDip.User_Id_Dip)='" & txt1 & "'))"
oConn.Execute (Strsql)
End Sub
Frmmain (form Chiamata da frmlogin)Private Sub CB_Amministrazione_Click() Unload Me
frm1.Show
End Sub
Private Sub CB_Gestione_Click() Unload Me
frm1.Show
End Sub
Private Sub CB_Ricerca_Click() Unload Me
frm1.Show
End Sub
Private Sub CB_Rientri_Click() Unload Me
frm1.Show
End Sub
Private Sub CB_Tesoro_Click() Unload Me
frm1.Show
End Sub
Private Function NameFilialeUser(CFiliale As Integer)Dim Strsql As String
Dim rs3 As ADODB.Recordset
Strsql = "SELECT FILIALI.Cod_fil, FILIALI.DENOMINAZIONE " & _
" FROM FILIALI " & _
" WHERE (((FILIALI.Cod_fil) =" & CFiliale & "))"
Set rs3 = oConn.Execute(Strsql)
If Not rs3.EOF Then
NameFilialeUser = rs3("DENOMINAZIONE")
Else
NameFilialeUser = ""
End If
rs3.Close
Set rs3 = Nothing
End Function
Private Sub UserForm_Activate()GM_ConnMDB
If AbilitationUser = -1 Then
FilialeUser = 99
End If
Me.Label_DUtente.Caption = "Utente: " & NameUser & " Orario: " & Date & " - " & Time
Me.Label_DFiliale.Caption = " Filiale: " & NameFilialeUser(FilialeUser)
Me.CB_Amministrazione.Locked = True
Me.CB_Tesoro.Locked = True
Me.CB_Gestione.Locked = True
Me.CB_Ricerca.Locked = True
Me.CB_Rientri.Locked = True
Me.CB_Amministrazione.ForeColor = vbRed
Me.CB_Tesoro.ForeColor = vbRed
Me.CB_Gestione.ForeColor = vbRed
Me.CB_Ricerca.ForeColor = vbRed
Me.CB_Rientri.ForeColor = vbRed
Select Case AbilitationUser
Case -1
Me.CB_Amministrazione.Locked = False
Me.CB_Tesoro.Locked = False
Me.CB_Gestione.Locked = False
Me.CB_Ricerca.Locked = False
Me.CB_Rientri.Locked = False
Me.CB_Amministrazione.ForeColor = vbBlack
Me.CB_Tesoro.ForeColor = vbBlack
Me.CB_Gestione.ForeColor = vbBlack
Me.CB_Ricerca.ForeColor = vbBlack
Me.CB_Rientri.ForeColor = vbBlack
Case 0
Case 1
Me.CB_Gestione.Locked = False
Me.CB_Gestione.ForeColor = vbBlack
Case 2
Me.CB_Ricerca.Locked = False
Me.CB_Tesoro.Locked = False
Me.CB_Rientri.Locked = False
Me.CB_Ricerca.ForeColor = vbBlack
Me.CB_Tesoro.ForeColor = vbBlack
Me.CB_Rientri.ForeColor = vbBlack
Case Else
End Select
' le istruzioni in colore Indigo, in caso di richiamata della form chiamata (frmmain) vengono eseguite come righe di codice ma non eseguono i comandi impostati. Non capisco perchè
Me.Caption = "Main - Procedura XXXXX " Unica istruzione eseguita correttamente se faccio riesegiuire la frmmain dopo un ritorno alla frmlogin per loggarsi con alter credenziali
End Sub
Private Sub UserForm_Terminate() Unload Me
frmLogin.Show
End Sub
Curiosità
Posso chiedervi del motivo per cui non potete permettere agli amici che si rivolgono a voi per problemi, di allegare file o documenti che meglio potrebbero descrivere i problema ?Grazie ancora di tutto
Moreno
