Newsgroup: it.comp.appl.access
Titolo: Chi mi controlla questo codice...??

salve amici... all'inserimento di dati in un DB... dopo aver inserito il
comune di nascita
su invio mi dovrebbe calcolare in automatico il CF... ma mi esce un errore
429..
che mi riporta al codice sottostante... con la riga evidenziata >....
ho controllato un suggerimento di Karl...sottoriportato ma non č servito a
niente...
-----------------------
Nella descrizione ce un sbaglio (sempre questi redattori ;-).
L'ultima riga invece di
"regsvr32.exe c:\...\dao350.dll"
debb' essere
regsvr32.exe "c:\...\dao350.dll"
-------------------------------------
Private Sub CercaCampiInRecord(Valore As String, MyPath As String, Campi()
As String)
 Dim Criterio As String
 Dim DataBaseAsl As Database, Tabella As Recordset, i As Integer, temp As
String
 >>> Set DataBaseAsl = OpenDatabase(MyPath)
 Set Tabella = DataBaseAsl.OpenRecordset("Comuni", dbOpenDynaset)
 Criterio = "Desc_comun = " & Chr(34) & Valore & Chr(34)
 Tabella.FindFirst Criterio
 ReDim Campi(Tabella.Fields.Count - 1) As String
 If Tabella.NoMatch Then
 Else
     For i = 0 To Tabella.Fields.Count - 1
      Campi(i) = Tabella.Fields(i)
     Next i
 End If
 DataBaseAsl.Close
End Sub
-----------------------
qualche altro suggerimento ??? Grazie...

 ho controllato un suggerimento di Karl...sottoriportato ma non è servito a

Bisognerebbe vedere come hai richiamato la funzione CercaCampiInRecord.
Non ho letto tutto il codice VBA, ma per quanto riguarda la riga di codice
che ti dà errore, se la tabella Comuni sta nel database corrente, prova a
scriverla:
Set DataBaseAsl = CurrentDB
--
Roberto
---------------------------------------------
il Sito Comune di it.comp.appl.access:
http://www.sitocomune.com
---------------------------------------------

 ha scritto nel messaggio
news:P87d7.5924$2L.1...@news.infostrada.it...
[cut]|
|
| Bisognerebbe vedere come hai richiamato la funzione CercaCampiInRecord.
| Non ho letto tutto il codice VBA, ma per quanto riguarda la riga di codice
| che ti dà errore, se la tabella Comuni sta nel database corrente, prova a
| scriverla:
|
| Set DataBaseAsl = CurrentDB
| Roberto
--------------------------------------------
Ciao Roberto... facendo come dici tu non da + errore però non mi calcola +
il CF... Cmq... non esiste nessuna tabella Comuni nel DB... il calcolo del
CF
viene effettuato in base agli inserimenti effettuati...
...beh ... ti riposto parte del Codice ...
--------------------------------------------------------
Option Compare Database
Option Explicit
Private Sub Tabella_Click()
On Error GoTo Err_Tabella_Click
    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "Progetto_Esenti_Ticket"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Tabella_Click:
    Exit Sub
Err_Tabella_Click:
    MsgBox Err.Description
    Resume Exit_Tabella_Click
End Sub
Private Sub Apertura_Maschera_Click()
On Error GoTo Err_Apertura_Maschera_Click
    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "Progetto_Esenti_Ticket"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Apertura_Maschera_Click:
    Exit Sub
Err_Apertura_Maschera_Click:
    MsgBox Err.Description
    Resume Exit_Apertura_Maschera_Click
End Sub
End Sub
Private Sub CasellaCombinata47_AfterUpdate()
End Sub
Private Sub CmbComNas_AfterUpdate()
 CmdCodFiscale_Click
End Sub
Private Sub Cognome_BeforeUpdate(Cancel As Integer)
End Sub
Private Sub Comando44_Click()
On Error GoTo Err_Comando44_Click
    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "Progetto_Esenti_Ticket"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Comando44_Click:
    Exit Sub
Err_Comando44_Click:
    MsgBox Err.Description
    Resume Exit_Comando44_Click
End Sub
Private Sub CercaCampiInRecord(Valore As String, MyPath As String, Campi()
As String)
 Dim Criterio As String
 Dim DataBaseAsl As Database, Tabella As Recordset, i As Integer, temp As
String
il problema lo crea qui........ >>> Set DataBaseAsl = OpenDatabase(MyPath)
 Set Tabella = DataBaseAsl.OpenRecordset("Comuni", dbOpenDynaset)
 Criterio = "Desc_comun = " & Chr(34) & Valore & Chr(34)
 Tabella.FindFirst Criterio
 ReDim Campi(Tabella.Fields.Count - 1) As String
 If Tabella.NoMatch Then
 Else
     For i = 0 To Tabella.Fields.Count - 1
      Campi(i) = Tabella.Fields(i)
     Next i
 End If
 DataBaseAsl.Close
End Sub
Private Sub CmbComuneResidenza_AfterUpdate()
Dim MyPath As String
  ReDim Campi(10) As String
  MyPath = "C:\Documenti\New_Project.mdb"
  Call CercaCampiInRecord(Me.CmbComuneResidenza, MyPath, Campi())
  Me.Com_Residenza = Campi(3)
  Me.Cod_Asl = Campi(1) & "/" & Campi(2)
End Sub
Private Sub CmdCodFiscale_Click()
  Dim ComuneNascita As String
  Dim MyPath As String
  ReDim Campi(10) As String
  MyPath = "C:\Documenti\New_Project.mdb"
  ComuneNascita = Me.CmbComNas
  Call CercaCampiInRecord(ComuneNascita, MyPath, Campi())
  Me.Cod_Fiscale = CalcolaCodiceFiscale(Me.Cognome, Me.Nome,
Me.Data_nascita, Me.Sex, Campi(4))
  Me.Com_Nascita = Campi(3)
End Sub
Private Function CalcolaCodiceFiscale(Cognome, Nome, Data_nascita, Sex,
CodComNas) As String
  Dim DATANASCITA As String * 8, COGN As String, NOM As String, SESSO As
String * 1
  Dim CODCOM As String * 4, ComuneNascita As String
  DATANASCITA = Left(Data_nascita, 6) + Right(Data_nascita, 2)
  CODCOM = CodComNas
  COGN = Cognome: NOM = Nome: SESSO = Sex
  CalcolaCodiceFiscale = CODICEFISCALE(COGN, NOM, DATANASCITA, SESSO,
CODCOM)
End Function
Function calcolaNumeroControlloFiscale(CodF) As Integer
   Dim T As Integer, J As Integer, Y As Integer, CAR As String * 1
    For T = 2 To 14 Step 2
      CAR = Mid(CodF, T, 1)
    If InStr("0123456789", CAR) Then
       J = J + Val(CAR)
    Else
       J = J + Asc(CAR) - 65
    End If
   Next T
For T = 1 To 15 Step 2
      CAR = Mid(CodF, T, 1)
    If InStr("BAKPLCQDREVOSFTGUHMINJWZXY", CAR) Then
       Y = Y + InStr("BAKPLCQDREVOSFTGUHMINJWZXY", CAR) - 1
    Else
       If InStr("0123456789", CAR) Then
          Select Case Val(CAR)
                Case Is = 0
                        Y = Y + 1
                Case 2 To 4
                        Y = Y + Val(CAR) * 2 + 1
                Case 5 To 9
                        Y = Y + Val(CAR) * 2 + 3
                Case Else
          End Select
       End If
    End If
Next T
calcolaNumeroControlloFiscale = Y + J
End Function
Private Function CODICEFISCALE(Cognome As String, Nome As String,
DATANASCITA As String, Ses As String, CODCOM As String) As String
    Dim Ann As String * 2
    Dim Mes As String * 2
    Dim Grn As String * 2
    Dim CodF As String * 15
    Dim NumControl As String * 1
    Ann = Mid(DATANASCITA, 7, 2)
    Mes = Mid(DATANASCITA, 4, 2)
    Grn = Left(DATANASCITA, 2)
    Mes = MeseFiscale(Val(Mes))
    If UCase(Ses) = "F" Then
       Grn = Mid(Str(Val(Grn) + 40), 2)
    End If
    CodF = NomeCognome(Nome, Cognome)
    CodF = Left(CodF, 6) + Ann + Left(Mes, 1) + Grn + CODCOM
    NumControl = Chr((calcolaNumeroControlloFiscale(Left(CodF, 15)) Mod 26)
+ 65)
    CODICEFISCALE = Left(CodF, 15) + NumControl
End Function
Public Function MeseFiscale(Mese As Integer) As String
  If Mese = 0 Then
    MeseFiscale = "**"
  Else
    MeseFiscale = Mid("ABCDEHLMPRST", Mese, 1)
  End If
End Function
Public Function NomeCognome(Nome As String, Cognome As String) As String
 ReDim NomeConsonanti(20) As String, NomeVocali(20) As String,
CognomeConsonanti(20) As String
 ReDim CognomeVocali(20) As String
 Dim NomeContCons As Integer, NomeContVocali As Integer, CognomeContCons As
Integer, CognomeContVocali As Integer
 Dim CGN As String * 3, NM As String * 3
 Call SeparaVocaliConsonanti(Cognome, CognomeConsonanti(), CognomeContCons,
CognomeVocali(), CognomeContVocali)
 Call SeparaVocaliConsonanti(Nome, NomeConsonanti(), NomeContCons,
NomeVocali(), NomeContVocali)
'-------------------------------------------------------------------------
'COGNOME
'-------------------------------------------------------------------------
If CognomeContCons >= 3 Then
  CGN = CognomeConsonanti(1) + CognomeConsonanti(2) + CognomeConsonanti(3)
ElseIf CognomeContCons = 2 Then
  CGN = CognomeConsonanti(1) + CognomeConsonanti(2) + CognomeVocali(1)
ElseIf CognomeContCons = 1 And CognomeContVocali >= 2 Then
  CGN = CognomeConsonanti(1) + CognomeVocali(1) + CognomeVocali(2)
ElseIf CognomeContCons = 1 And CognomeContVocali = 1 Then
  CGN = CognomeConsonanti(1) + CognomeVocali(1) + "X"
ElseIf CognomeContCons = 0 And CognomeContVocali = 2 Then
  CGN = CognomeVocali(1) + CognomeVocali(2) + "X"
ElseIf CognomeContCons = 0 And CognomeContVocali >= 3 Then
  CGN = CognomeVocali(1) + CognomeVocali(2) + CognomeVocali(3)
End If
'-------------------------------------------------------------------------
' NOME
'-------------------------------------------------------------------------
If NomeContCons >= 4 Then
   NM = NomeConsonanti(1) + NomeConsonanti(3) + NomeConsonanti(4)
ElseIf NomeContCons = 3 Then
  NM = NomeConsonanti(1) + NomeConsonanti(2) + NomeConsonanti(3)
ElseIf NomeContCons = 2 Then
   NM = NomeConsonanti(1) + NomeConsonanti(2) + NomeVocali(1)
ElseIf NomeContCons = 1 And NomeContVocali >= 2 Then
   NM = NomeConsonanti(1) + NomeVocali(1) + NomeVocali(2)
ElseIf NomeContCons = 1 And NomeContVocali = 1 Then
   NM = NomeConsonanti(1) + NomeVocali(1) + "X"
ElseIf NomeContCons = 0 And NomeContVocali = 2 Then
   NM = NomeVocali(1) + NomeVocali(2) + "X"
ElseIf NomeContCons = 0 And NomeContVocali >= 3 Then
   NM = NomeVocali(1) + NomeVocali(2) + NomeVocali(3)
End If
'-------------------------------------------------------------------------
NomeCognome = CGN + NM
End Function
Sub SeparaVocaliConsonanti(Stringa As String, VettConsonanti() As String,
ContCons As Integer, VettVocali() As String, ContVocali As Integer)
Dim w As Integer, LT As String * 1
ContCons = 0: ContVocali = 0
For w = 1 To Len(Stringa)
    LT = Mid$(Stringa$, w, 1)
    If Asc(LT) >= 65 And Asc(LT) <= 90 Then
        If InStr("AEIOU", LT) = 0 Then
                ContCons = ContCons + 1: VettConsonanti(ContCons) = LT
        Else
                ContVocali = ContVocali + 1: VettVocali(ContVocali) = LT
        End If
    End If
Next w
End Sub

 ...beh ... ti riposto parte del Codice ...
DEVE ESISTERE!!
Così come è scritto nel codice VBA che mi hai postato, la tabella Comuni
deve essere contenuta nel database New_Project.mdb contenuto nel folder
Documenti del disco rigido C.
Questo c'è scritto nella routine VBA chiamata
cmbComuneResidenza_AfterUpdate():
**********************
Private Sub CmbComuneResidenza_AfterUpdate()
Dim MyPath As String
  ReDim Campi(10) As String
  MyPath = "C:\Documenti\New_Project.mdb"
**********************
Quindi, se nel folder Documenti del disco C non inserisci un database
chiamato New_Project.mdb che contiene a sua volta una tabella chiamata
Comuni, non ti funzionerà nulla ed è giusto che Access ti segnali errore al
momento dell'esecuzione della riga di codice VBA che cerca di aprire tale
database che, a quanto sembra, nel tuo computer non esiste.
Forse è bene che tu dia una attenta lettura alle FAQ del Sito Comune
relative alla creazione ed al controllo del CF.


 ha scritto nel messaggio
news:64fd7.8441$2L.2...@news.infostrada.it...
|
| > [cut]|
| > |
| > | Set DataBaseAsl = CurrentDB
| >
| > | Roberto
| > --------------------------------------------
| |
| DEVE ESISTERE!!
| Così come è scritto nel codice VBA che mi hai postato, la tabella Comuni
| deve essere contenuta nel database New_Project.mdb contenuto nel folder
| Documenti del disco rigido C.
| Questo c'è scritto nella routine VBA chiamata
| cmbComuneResidenza_AfterUpdate():
|
| **********************
| Private Sub CmbComuneResidenza_AfterUpdate()
| Dim MyPath As String
|   ReDim Campi(10) As String
|   MyPath = "C:\Documenti\New_Project.mdb"
| **********************
|
| Quindi, se nel folder Documenti del disco C non inserisci un database
| chiamato New_Project.mdb che contiene a sua volta una tabella chiamata
| Comuni, non ti funzionerà nulla ed è giusto che Access ti segnali errore
al
| momento dell'esecuzione della riga di codice VBA che cerca di aprire tale
| database che, a quanto sembra, nel tuo computer non esiste.
----------------------
Ciao Roberto... giustamente come al solito hai ragione...
la Tabella Comuni esiste... solo che era selezionata nascosta....
Cmq... il problema non l'ho risolto... nel senso che anche rispettando
Path e percorsi... mi esce sempre l'errore di "429"...
ho provato anche a togliere il Path e sostituirlo nel codice con C:\...
ma il problema persiste.... cmq... non fa niente...seguirò il tuo consiglio
di leggermi attentamente le Faq riguardanti il CF....dopo ferragosto...
intanto colgo l'occasione x augurarti un felice Ferragosto a te e
famiglia....
Ciao....

 Ciao....
Buon Ferragosto anche a te alla tua famiglia.
Ciao
Roberto