Option Compare Database
Option Explicit
Function Esta_Buit(Casella, tipUs)
Dim Valid
'Tipus 0 - No necesita revisio, 1 - Tel. 2 - Email
If Nz(Casella, "") = "" Then
Esta_Buit = 1
Else
Select Case tipUs
Case 0
Esta_Buit = 0
Case 1
If Len(Casella) = 9 Then
Esta_Buit = 0
Else
MsgBox "Alerta! Teléfon incorrecte", vbCritical, "Error"
Esta_Buit = 1
txt_fix.SetFocus
End If
Case 2
Valid = InStr(Casella, "@")
If Valid = 0 Then
MsgBox "Falta una @"
Esta_Buit = 1
txt_email.SetFocus
Else
Valid = InStr(Casella, ".")
If Valid = 0 Then
MsgBox "Falta una ."
Esta_Buit = 1
txt_email.SetFocus
End If
End If
Esta_Buit = 0
End Select
End If
End Function
Function Valida_Nif(nif)
Dim DNI, letra_dni, DNINULL
DNI = txt_dni.Value
DNINULL = 0
'SI EL DNI TE UNA LONGITUD DE 8, AFEGIM LA LLETRA AL FINAL
If (Len(DNI) = 8) Then
Select Case Left$(DNI, 1)
Case Is = "X"
letra_dni = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "X", "0")) Mod 23) + 1, 1)
Case Is = "Y"
letra_dni = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "Y", "1")) Mod 23) + 1, 1)
Case Is = "Z"
letra_dni = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "Z", "2")) Mod 23) + 1, 1)
Case Else
letra_dni = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(DNI) Mod 23) + 1, 1)
End Select
txt_dni.Value = DNI & letra_dni
DNINULL = 1
Else
'SI ES MES GRAN DE 9 NO ES CORRECTE
If (Len(DNI) > 9) Then
MsgBox "Alerta! Sobren xifres al DNI!", vbExclamation, "Informació"
DNINULL = 1
txt_dni.Value = ""
txt_dni.SetFocus
Else
'SI ES MES PETIT DE 8 NO ES CORRECTE
If (Len(DNI) < 8) Then
MsgBox "Alerta! Falten xifres al DNI!", vbExclamation, "Informació"
DNINULL = 1
txt_dni.Value = ""
txt_dni.SetFocus
Else
If (Len(DNI = 9)) Then
letra_dni = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(DNI) Mod 23) + 1, 1)
If Right(DNI, 1) <> letra_dni Then
MsgBox "Alerta! Sembla que la lletra del DNI no es correcta", vbExclamation, "Informació"
txt_dni.SetFocus
DNINULL = 0
Else
DNINULL = 1
End If
End If
End If
End If
End If
If DNINULL = 0 Then
Valida_Nif = 1
Else
Valida_Nif = 0
End If
End Function
Private Sub btn_alta_Click()
Dim Caselles_Buides, Continuar_igualment
Dim SQL_Insert, SQL_Values
Caselles_Buides = 0
Caselles_Buides = Valida_Nif(txt_dni)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_nom.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_c1.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_c2.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_data_naixement.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_domicili.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_cp.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_poblacio.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_fix.Value, 1)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_mobil.Value, 1)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_email.Value, 2)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_data_alta.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_taula.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_seient.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_pis.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_compadre.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_sexe.Value, 0)
Caselles_Buides = Caselles_Buides + Esta_Buit(txt_llengua.Value, 0)
If Caselles_Buides > 0 Then
Continuar_igualment = MsgBox("Falta omplenar les dades de " & Caselles_Buides & " camps" & Chr(13) & "Vol continuar de totes formes?", vbYesNo, "Alerta")
End If
If Caselles_Buides = 0 Or Continuar_igualment = 6 Then
SQL_Insert = "INSERT INTO tblSocis(NUMSOCI, COGNOM1, COGNOM2, NOM, DOMICILI, POBLACIO, CODIPOSTAL, TELEFON, MOBIL, MAIL, FECALTA, FECNAIXAMENT, LLOCNAIXEMENT, PROVNAIXEMENT, SEXE, ESTATCIVIL, DNI, CONJUGE, LLENGUA, FESTES, EXCURSIONS, AVISOS, BAIXA, FECBAIXA, MOTIUBAIXA, OBSERVACIONS, RUTAIMAGEN, NUMESCPISPOR, COMPLEMADREÇA) VALUES "
SQL_Values = "(" & txt_num_soci.Value & ",'" & txt_c1.Value & "','" & txt_c2.Value & "','" & txt_nom.Value & "','" & txt_domicili.Value & "','" & txt_poblacio.Value & "','" & txt_cp.Value & "','" & txt_fix.Value & "','" & txt_mobil.Value & "','" & txt_email.Value & "',#" & txt_data_alta.Value & "#,#" & txt_data_naixement.Value & "#,'','','','','" & txt_dni.Value & "'," & lst_conjuge.Value & ",'" & txt_llengua.Value & "'," & txt_taula.Value & "," & txt_seient.Value & ",'','','','','" & lst_observacions.Value & "','" & txt_num_soci.Value & ".jpg','" & txt_pis.Value & "','" & txt_compadre.Value & "')"
'Revisem quines dades esta inserint descomentar per fer supervisio
'MsgBox SQL_Insert & Chr(13) & SQL_Values
DoCmd.SetWarnings False
DoCmd.RunSQL SQL_Insert & SQL_Values
MsgBox "Soci inserit correctament" & Chr(13) & "Núm Soci: " & txt_num_soci.Value & Chr(13) & _
"DNI: " & txt_dni.Value & Chr(13) & _
"Nom complert: " & txt_nom.Value & " " & txt_c1.Value & " " & txt_c2.Value & Chr(13) & _
"Domicili: " & txt_domicili.Value & " " & txt_pis.Value & " " & txt_compadre.Value & " " & txt_poblacio.Value & " " & txt_cp.Value & Chr(13) & _
"Tel Fix: " & txt_fix.Value & " Tel. Mòbil: " & txt_mobil.Value & Chr(13) & _
"Email: " & txt_email.Value & Chr(13) & _
"Taula Festes: " & txt_taula.Value & " Seient autobús: " & txt_seient.Value, vbInformation, "Informació"
'-> Esborrem les dades, aixó podría anar en una funcio unica que es crida tant al premer el boto esborrar como inserir
txt_num_soci.Value = ""
txt_nom.Value = ""
txt_c1.Value = ""
txt_c2.Value = ""
txt_dni.Value = ""
txt_data_naixement.Value = ""
txt_domicili.RowSource = "SELECT CnsCarrersAlfa.NOMCARRER, CnsCarrersAlfa.CP, CnsCarrersAlfa.municipi FROM CnsCarrersAlfa WHERE (((CnsCarrersAlfa.NOMCARRER) Like '*' & [Quin carrer desitjes] & '*')) ORDER BY CnsCarrersAlfa.NOMCARRER, CnsCarrersAlfa.[CP];"
txt_domicili.Requery
txt_domicili.Value = ""
txt_cp.Value = ""
txt_poblacio.Value = ""
txt_fix.Value = ""
txt_mobil.Value = ""
txt_email.Value = ""
txt_data_alta.Value = ""
txt_taula.Value = ""
txt_seient.Value = ""
lst_conjuge.Value = ""
lst_observacions.Value = ""
txt_pis.Value = ""
txt_compadre.Value = ""
txt_sexe.Value = ""
txt_llengua.Value = ""
'Cridem a form_load per recalcular el ID
Call Form_Load
DoCmd.SetWarnings True
End If
End Sub
Private Sub btn_esborrar_Click()
Dim Resultat
'Confirmem que l'usuari vol esborrar les dades, si es aixi procedim, si no no fem res
Resultat = MsgBox("Atenció, esta a punt de netejar totes les caselles, vol continuar?", vbInformation + vbYesNo, "Alerta")
If Resultat = 6 Then
txt_num_soci.Value = ""
txt_nom.Value = ""
txt_c1.Value = ""
txt_c2.Value = ""
txt_dni.Value = ""
txt_data_naixement.Value = ""
txt_domicili.RowSource = "SELECT CnsCarrersAlfa.NOMCARRER, CnsCarrersAlfa.CP, CnsCarrersAlfa.municipi FROM CnsCarrersAlfa WHERE (((CnsCarrersAlfa.NOMCARRER) Like '*' & [Quin carrer desitjes] & '*')) ORDER BY CnsCarrersAlfa.NOMCARRER, CnsCarrersAlfa.[CP];"
txt_domicili.Requery
txt_pis.Value = ""
txt_compadre.Value = ""
txt_sexe.Value = ""
txt_llengua.Value = ""
txt_cp.Value = ""
txt_poblacio.Value = ""
txt_fix.Value = ""
txt_mobil.Value = ""
txt_email.Value = ""
txt_data_alta.Value = ""
txt_taula.Value = ""
txt_seient.Value = ""
lst_conjuge.Value = ""
lst_observacions.Value = ""
txt_pis.Value = ""
txt_compadre.Value = ""
txt_sexe.Value = ""
txt_llengua.Value = ""
Call Form_Load
End If
End Sub
Private Sub cmdCerrar_Click()
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm "Switchboard"
End Sub