CODICE VBA PER VERIFICA ESISTENZA VALORE CAMPO

Question

Ciao a tutti,

ogni tanto devo chiedere il vs aiuto per risolvere qualche mio problema.

Il problema di cui chiedo il vs aiuto è il seguente:

"Vorrei, a mezzo cidice VBA, verificare se esiste, nella tabella di riferimento, il valore digitato in un campo specifico. CIò al fine di evitare di creare delle duplicazioni".

Ho creato una tabella chiamata "PROGETTI", composta da numerosi record, in cui ho la necessità di verificare, una volta digitato mediante un maschera, se il valore inserito per il campo CUP_PROGETTO è già presente nella tabella.

Una immagine della tabella (ridotta a pochi campi)

Esempio:

Per un nuovo progetto dopo aver digitato l'oggetto, scelto il settore, inserisco il cup_progetto.

Il codice VBA mi dovrebbe verificare se il CUP appena digitato e già presente fra tutti i codici cup_progetto già presenti nella tabella e, nel caso fosse presente mi dovrebbe indicare mediante msgbox "Il codice CUP digitato è già presente in archivio ed è associato al progetto n. xxx".

Grazie per il vs validissimo aiuto.

Luca

Answer 1

ciao Luca,

boh, senza vedere l'applicazione non riesco ad intuire il problema.

prova in quest'altro modo :

Private Sub Sub CUP_PROGETTO_BeforeUpdate(Cancel As Integer)

Dim lngIDprogetto As Long

With Me

    If Len(.CUP_PROGETTO & vbNullString) = 0 Then

        VBA.MsgBox prompt:="Il progetto non e' stato compilato!", _

                   buttons:=vbCritical, _

                   Title:="Attenzione"

        Cancel = True

        Exit Sub

    End If

    If DCount("*", "PRogetti", "CUP_PROGETTO='" & Replace(.CUP_PROGETTO, "'", "''") & "'") > 0 Then

           lngIDprogetto = dlookUP("id_prog","Progetti","CUP_PROGETTO='" & Replace(.CUP_PROGETTO, "'", "''") & "'")

        VBA.MsgBox prompt:="Il codice CUP digitato -->" & .CUP_progetto & " <--? gia' presente in archivio ed ? associato al progetto n." & lngIDprogetto, _

                   buttons:=vbCritical, _

                   Title:="Attenzione"

        Cancel = True

        .Undo

    End If

End With

End Sub

ciao, Sandro.

Answer 2

ciao Luca,

vedi se come segue centri l'obbiettivo

---> CODICE VBA DI CUI SOPRA <---

ciao, Sandro.

Ciao Sandro,

intanto grazie per avermi risposto, ho provato il codice da te postato ma la procedura mi restituisce un errore del tipo (vedi immagine), quando il CUP_PROGETTO è già presente

il codice che viene evidenizato al verificarsi dell'errore stà nella riga:

Spero di non disturbarti oltre !!!

Ciao

Luca

Answer 3

ciao Luca,

perche' continui a postare il codice con l'evento after update quando a piu' riprese ti ho suggerito before update? anche before insert potrebbe essere opportuno per quanto alla scelta dell'evento.

la dlookup e' impostata male, riformulala testando il codice passo passo.

Ciao, Sandro.

Ciao Sandro,

in effetti avevo seguito il tuo consiglio ed il codice è impostato su Prima di Aggiornare (before update) come da te suggerito.

Private Sub CUP_PROGETTO_BeforeUpdate(Cancel As Integer)

If Len(Me!CUP_PROGETTO & vbnullstring) = 0 Then

    Exit Sub

End If

    If Not IsNull(DLookup("CUP_PROGETTO", "PROGETTI", "CUP_PROGETTO='" & Replace(Me!CUP_PROGETTO, "'", "''") & "'")) And Me!CUP_PROGETTO <> Nz(Me!CUP_PROGETTO.OldValue) Then

MsgBox "Il CUP digitato è già presente in archivio !", vbInformation

    Me.Undo

    End If

End Sub

Ho testato la runtime e funziona corettamente!

Mi resta solo da risolvere   l'ultimo passaggio dell'identificativo dell'ID_PROG associato al CUP_PROGETTO già presente in tabella., da solo non riesco ad immaginare come.

Ciao e grazie ancora

Luca

Answer 4

ciao Luca,

perche' continui a postare il codice con l'evento after update quando a piu' riprese ti ho suggerito before update? anche before insert potrebbe essere opportuno per quanto alla scelta dell'evento.

la dlookup e' impostata male, riformulala testando il codice passo passo.

Ciao, Sandro.

Answer 5

ciao Luca,

….mmmm…..hai provato come consigliato in precedenza su before update?

inoltre questa riga :

If Len(Me!CUP_PROGETTO & "") = 0 Then

modificala con & vbnullstring, con "" l'esecuzione e' piu'lenta.

copia incolla il resto del codice e rimuovi il commento nella riga cancel=true.

Modifica anche la dlookup, non serve il controllo is not null, ma la sola presenza del progetto.

Alternativa alla dlookup, la dcount con verifica =1.

Facci sapere.

ciao, Sandro.

Ciao Sandro,

dici di modificare in questo modo?

Private Sub CUP_PROGETTO_AfterUpdate()

If Len(Me!CUP_PROGETTO & vbnullstring) = 0 Then

    Exit Sub

End If

    If DLookup("CUP_PROGETTO", "PROGETTI", "CUP_PROGETTO='" & Replace(Me!CUP_PROGETTO, "'", "''") & "'")) And Me!CUP_PROGETTO <> Nz(Me!CUP_PROGETTO.OldValue) Then

MsgBox "Il CUP digitato è già presente in archivio !", vbInformation

    Me.Undo

    CUP_PROGETTO.SetFocus

    End If

End Sub

Però ancora non ho capito dove e come estrapolare ID_PROG della tabella PROGETTI da inserire nella msgbox

Grazie

Luca