Originariamente inviata da
sixdas
Ciao, grazie per l'esempio, il tuo codice fa proprio quello che volevo io. Adesso vorrei adattarlo per le mie esigenze e vorrei farti qualche domanda.
1) Posso ripetere quel pezzo di codice per ogni campo che voglio modificare, oppure ci sono problemi?
2) Visto che ho devo salvare anche testo libero e non solo date, con cosa devo modificare IsDate?
Grazie ancora.
Sì, sostanzialmente devi ripetere il codice per ogni campo però con qualche accortezza.
Nel'esempio che segue ho immaginando che oltre al campo data ci sia anche un campo numerico e uno alfanumerico che ho chiamato campo_num e campo_alfanum con i corrispondenti campi del db campo_num_db e campo alfanum_db ed inoltre ho tolto un po' di Value inutili e ho cambiato il nome della cella E15 da data_db a data_ritiro_db per uniformità con gli altri.
Nota che le righe precedute da un apice servono per commentare il codice e non vengono eseguite quindi puoi aggiungerne quante te ne pare per descrivere quello che viene fatto in ogni punto.
Devi poi indicare il corretto offset per ogni campo, il 5 è corretto per la data perché la data si trova 5 posizioni a destra rispetto al codice cliente, per campo_num e campo_alfanum ho messo un 6 e 7 di fantasia, devi adeguarli a quelli veri semplicemente contando le colonne a partire dal codice cliente.
Occhio che se in futuro aggiungerai colonne al database dovrai aggiornare gli offset perché excel non lo fa in automatico.
codice:
Private Sub Worksheet_Change(ByVal Target As Range)
' Prima IF. Non va ripetuta ma vanno ripetuti i campi da pulire
If Not Intersect(Target, Range("cod_cliente")) Is Nothing Then
Range("data_ritiro") = ""
Range("campo_num") = ""
Range("campo_alfanum") = ""
End If
' Seconda If. Questa va ripetuta per ogni campo
' Campo data
If Not Intersect(Target, Range("data_ritiro")) Is Nothing And _
Range("data_ritiro") <> "" And _
Not IsError(Range("data_ritiro_db")) _
Then
If Range("data_ritiro_db") = "00.00.00" And _
Range("cod_cliente") <> "" And _
IsDate(Range("data_ritiro")) _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 5) = Range("data_ritiro")
Range("data_ritiro") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
' Campo numerico
If Not Intersect(Target, Range("campo_num")) Is Nothing And _
Range("campo_num") <> "" And _
Not IsError(Range("campo_num_db")) _
Then
If Range("campo_num_db") = 0 And _
Range("cod_cliente") <> "" And _
IsNumeric(Range("campo_num")) _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 6) = Range("campo_num")
Range("campo_num") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
' Campo alfanumerico
If Not Intersect(Target, Range("campo_alfanum")) Is Nothing And _
Range("campo_alfanum") <> "" And _
Not IsError(Range("campo_alfanum_db")) _
Then
If Trim(Range("campo_alfanum_db")) = 0 And _
Range("cod_cliente") <> "" _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 7) = Range("campo_alfanum")
Range("campo_alfanum") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
End Sub
Prima di provarlo però devo dirti ancora alcune cose.
Ho visto che c'è un malfunzionamento perché il formato data attribuito alla casella data_ritiro trasforma automaticamente i numeri in date e così questi passano il test isDate e vengono inserite date sbagliate nel db.
Prova, ad esempio, a scrivere 555 e vedi che succede.
Per risolvere devi dare il formato Generale alla casella e lo stesso dovrai fare per tutti i campi gialli da digitare.
Un altro malfunzionamento si ha sui campi alfanumerici perché la cerca.vert assegna il valore zero alla cella in caso di assenza di valore sul db, questo lo puoi superare dando alla cella campo_alfanum_db il formato personalizzato # (cancelletto).
A livello di codice questo problema obbliga a fare i test dei campi alfanumerici su 0 invece di "" come sarebbe più logico ma va bene così, non ci si può far nulla per quanto ne so.
Come avrai visto ogni volta che apri un foglio con macro devi ricordarti di attivarle ma puoi superare questa cosa inserendo il foglio in una cartella e poi dicendo a excel di attivare automaticamente le macro per tutti i fogli contenuti in quella cartella, così non te lo chiede ogni volta. Si fa dalle Opzioni --> Centro protezione --> Impostazioni --> Percorsi attendibili
Visto che i campi sono molti puoi migliorare il funzionamento attivando la casella gialla solo per i campi per i quali è necessario inserire il dato in modo che non si faccia confusione con tutte quelle caselle gialle inutili sempre visibili.
Per farlo devi dare un nome anche alla casella affianco alla casella gialla, la B17, tanto per capirci, per esempio data_ritiro_msg o campo_num_msg o campo_alfanum_msg e poi usare questo codice:
codice:
Private Sub Worksheet_Change(ByVal Target As Range)
' Prima IF. Non va ripetuta ma vanno ripetute le istruzioni di pulizia di ogni campo
If Not Intersect(Target, Range("cod_cliente")) Is Nothing Then
' Pulizia di data ritiro
Range("data_ritiro") = ""
If Range("data_ritiro_db") = "00.00.00" Then
Range("data_ritiro").Interior.Color = vbYellow
Range("data_ritiro_msg") = "Inserisci Data ritiro"
Else
Range("data_ritiro").Interior.ColorIndex = xlColorIndexNone
Range("data_ritiro_msg") = ""
End If
' Pulizia di campo num
Range("campo_num") = ""
If Range("campo_num_db") = 0 Then
Range("campo_num").Interior.Color = vbYellow
Range("campo_num_msg") = "Inserisci Campo num"
Else
Range("campo_num").Interior.ColorIndex = xlColorIndexNone
Range("campo_num_msg") = ""
End If
' Pulizia di campo alfanum
Range("campo_alfanum") = ""
If Range("campo_alfanum_db") = 0 Then
Range("campo_alfanum").Interior.Color = vbYellow
Range("campo_alfanum_msg") = "Inserisci Campo alfanum"
Else
Range("campo_alfanum").Interior.ColorIndex = xlColorIndexNone
Range("campo_alfanum_msg") = ""
End If
End If
' Seconda If. Questa va ripetuta per ogni campo
' Campo data
If Not Intersect(Target, Range("data_ritiro")) Is Nothing And _
Range("data_ritiro") <> "" And _
Not IsError(Range("data_ritiro_db")) _
Then
If Range("data_ritiro_db") = "00.00.00" And _
Range("cod_cliente") <> "" And _
IsDate(Range("data_ritiro")) _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 5) = Range("data_ritiro")
Range("data_ritiro") = ""
Range("data_ritiro").Interior.ColorIndex = xlColorIndexNone
Range("data_ritiro_msg") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
' Campo numerico
If Not Intersect(Target, Range("campo_num")) Is Nothing And _
Range("campo_num") <> "" And _
Not IsError(Range("campo_num_db")) _
Then
If Range("campo_num_db") = 0 And _
Range("cod_cliente") <> "" And _
IsNumeric(Range("campo_num")) _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 6) = Range("campo_num")
Range("campo_num") = ""
Range("campo_num").Interior.ColorIndex = xlColorIndexNone
Range("campo_num_msg") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
' Campo alfanumerico
If Not Intersect(Target, Range("campo_alfanum")) Is Nothing And _
Range("campo_alfanum") <> "" And _
Not IsError(Range("campo_alfanum_db")) _
Then
If Trim(Range("campo_alfanum_db")) = 0 And _
Range("cod_cliente") <> "" _
Then
For Each cliente In Sheets("Databse").Range("A:A")
If CStr(cliente) = CStr(Range("cod_cliente")) Then
cliente.Offset(0, 7) = Range("campo_alfanum")
Range("campo_alfanum") = ""
Range("campo_alfanum").Interior.ColorIndex = xlColorIndexNone
Range("campo_alfanum_msg") = ""
Exit For
Else
If cliente = "" Then
Exit For
End If
End If
Next
End If
End If
End Sub
Non ho fatto test molto approfonditi quindi se qualcosa non funziona scrivi pure che lo mettiamo a posto.
Permessi di invio
Rispondi quotando
