[DATABASE Lotus] Approach

[gavino]

Salve
Lavoro con un database della Lotus, precisamente con Approach
mi occorre sapere se ce la possibilità," o qualche macro " per inserire in automatico il codice fiscale usando i campi già esistenti nel database ( i campi sono Nome e Cognome, Citta, Data Nascita, Sesso ) :quipy:
Grazie

[tomhead]

ti posso aiutare con del codice VB6 ...

[ladyBlu]

Ti consiglio di leggere il regolamento, in particolare la sezione riguardante i Titoli delle discussioni.
Benvenuto

[gavino]

Per LadyBlu
Delucidami dove trovo il regolamento,
scusatemi se ho sbagliato.

[ladyBlu]

Originariamente inviato da gavino
Per LadyBlu
Delucidami dove trovo il regolamento,
scusatemi se ho sbagliato.

Lo trovi in alto alla pagina del forum di Visual Basic.
In ogni caso ti lascio qui il link: REGOLAMENTO

[tomhead]

Option Explicit

Private m_Cognome As String
Private m_Nome As String
Private m_Sesso As String
Private m_DataNascita As String
Private m_Comune As String
Private m_Codice As String * 16
Private m_Valido As Boolean
Private m_Controllo As String * 1

Public Property Let Cognome(cString As String)
   m_Cognome = cString
End Property

Public Property Let nome(cString As String)
   m_Nome = cString
End Property

Public Property Let dataNascita(dString As Date)
   m_DataNascita = dString
End Property

Public Property Let Sesso(cString As String)
   m_Sesso = cString
End Property

Public Property Let Comune(cString As String)
   m_Comune = cString
End Property

Public Property Let Codice(vNewValue As String)
   m_Codice = vNewValue
End Property

Public Property Get Valido()
   Dim X As String
   X = digit(Left(m_Codice, 15))
   Valido = IIf(X = Right(m_Codice, 1), True, False)
End Property

Public Property Get Codice() As String
   Dim Consonanti As String
   Dim Vocali As String
   Dim i As Integer
   Dim cTemp As String
   Dim StrigaConfronto As String
   'Calcolo della Parte 1: Cognome
   Consonanti = ""
   Vocali = ""
   For i = 1 To Len(m_Cognome)
      cTemp = Mid(m_Cognome, i, 1)
      If InStr("AEIOU", cTemp) Then
         If Len(Vocali) < 2 Then
            Vocali = Vocali & cTemp
         End If
      Else
         If Asc(cTemp) > 64 And Asc(cTemp) < 91 And Len(Consonanti) < 3 Then
            Consonanti = Consonanti & cTemp
         End If
      End If
   Next
      StrigaConfronto = Mid(Consonanti & Vocali & "X", 1, 3)
   If Len(StrigaConfronto) < 3 Then StrigaConfronto = StrigaConfronto & "X"
   'Calcolo della Parte 2: Nome
   Consonanti = ""
   Vocali = ""
   For i = 1 To Len(m_Nome)
      cTemp = Mid(m_Nome, i, 1)
      If InStr("AEIOU", cTemp) Then
         If Len(Vocali) < 2 Then
            Vocali = Vocali & cTemp
         End If
      Else
         If Asc(cTemp) > 64 And Asc(cTemp) < 91 And Len(Consonanti) < 4 Then
            Consonanti = Consonanti & cTemp
         End If
      End If
      If Len(Consonanti) > 3 Then
         Consonanti = Mid(Consonanti, 1, 1) & Mid(Consonanti, 3, 2)
         i = Len(m_Nome)
      End If
   Next
   If Len(Mid(Consonanti & Vocali & "X", 1, 3)) < 3 Then
      StrigaConfronto = StrigaConfronto & Mid(Consonanti & Vocali & "X", 1, 3) & "X"
   Else
     StrigaConfronto = StrigaConfronto & Mid(Consonanti & Vocali & "X", 1, 3)
   End If
   'Anno di nascita
   StrigaConfronto = StrigaConfronto & Mid(Year(m_DataNascita), 3, 2)
   'Mese di nascita
   StrigaConfronto = StrigaConfronto & Mid("ABCDEHLMPRST", Month(m_DataNascita), 1)
   'Giorno di nascita
   StrigaConfronto = StrigaConfronto & IIf(m_Sesso = "M", Mid(Format(100 + Day(m_DataNascita)), 2, 2), Mid(Format(140 + Day(m_DataNascita)), 2, 2))
   'Codice Comune di nascita
   StrigaConfronto = StrigaConfronto & m_Comune
   'Numero di controllo
   If Len(StrigaConfronto) = 15 Then
      StrigaConfronto = StrigaConfronto & digit(StrigaConfronto)
      Codice = StrigaConfronto
   Else
      MsgBox "I dati immessi non sono validi", vbCritical, "Errore di input"
   End If
End Property

Private Function digit(xCodice)
On Error GoTo Err
   Dim sc As String
   Dim cPari As String
   Dim cDispari As String
   Dim numCTRL As Integer
   Dim i As Integer
   Dim temp As Integer
   '
   sc = "01,00,05,07,09,13,15,17,19,21,02,04,18,20,11,03,06,08,12,14,16,10,22,25,24,23"
   numCTRL = 0
   For i = 2 To 14 Step 2
      cPari = Mid(xCodice, i, 1)
      If cPari >= "A" Then
         temp = Asc(cPari) - Asc("A")
      Else
         temp = Asc(cPari) - Asc("0")
      End If
      numCTRL = numCTRL + temp
   Next i
   For i = 1 To 15 Step 2
      cDispari = Mid(xCodice, i, 1)
      If cDispari >= "A" Then
         temp = Val(Mid(sc, (Asc(cDispari) - Asc("A")) * 3 + 1, 2))
      Else
         temp = Val(Mid(sc, (Asc(cDispari) - Asc("0")) * 3 + 1, 2))
      End If
      numCTRL = numCTRL + temp
   Next i
   numCTRL = (numCTRL Mod 26) + 65
   digit = Chr(numCTRL)
Exit Function
Err:
    MsgBox "Si è verificato un errore durante la creazione del codice fiscale.", vbCritical, "Attenzione!"
End Function