Newsgroup: it.comp.appl.access
Titolo: filtri associativi con combo box

ho scritto un modulo "riutilizzabile" per implementare dei filtri
associativi con delle combo, adesso gestisce combo con tipo di dato
qualunque (o quasi), basta buttare una o più combo vuote non associate in
una maschera filtrabile e seguire le istruzioni nel modulo, e le combo
filtreranno la maschera e i loro stessi row source "magicamente" .
l'ho fatto in fretta a tempo perso, sembra funzionare bene ma vorrei essere
sicuro... qualcuno ha voglia di testarlo per aiutarmi nel debug?
___________________________________________________________________
Public Sub filtra(FormName As String)
'questa funzione serve per implementare funzioni di filtro associativo
'per mezzo di combo box non associate su una maschera, la funzione và
chiamata
'all'evento Load della maschera e a ogni evento AfterUpdate delle combo
'
'Private Sub <nomecombo>_AfterUpdate()
'
'    filtra (Me.Name)
'
'End Sub
'
'limiti: non è importante settare il RowSource delle combo, ci pensa la
funzione
'richiamata all'avvio della maschera, l'importante è settare la proprietà
Tag delle
'combo CON IL NOME DEL CAMPO CHE SI DEVE FILTRARE.
'ATTENZIONE: il RecordSource della maschera contenente le combo può
contenere solo
'il nome di una query o tabella, se è impostato a una istruzione SQL
esplicità
'la funzione darà errori, INOLTRE IL NOME DEL CAMPO DEVE ESSERE UNIVOCO
'IN TUTTO IL DATABASE
'SI CONSIGLIA: nell'evento DblClick delle combo scrivere il seguente codice:
'
'Private Sub <nomecombo>_DblClick(Cancel As Integer)
'
'   Me.<nomecombo>.Text = ""
'   strDivisione = ""
'   Call filtra(Me.Name)
'
'End Sub
    Dim Mask As Form
    Dim cmb As Control
    Dim filtro As String
    Dim Tipo As String
    Dim Valore As String
    filtro = ""
    Set Mask = Forms(FormName)
        For Each cmb In Mask
            If cmb.ControlType = acComboBox And IsNull(cmb.Tag) = False And
cmb.Tag <> "" Then
                If IsNull(cmb) = False Then
                    Tipo = FindField(cmb.Tag)
                    Valore = cmb
                    If Tipo = "testo" Then
                        If InStr(Valore, Chr(34)) = 0 Then
                            filtro = filtro & " and " & cmb.Tag & "=" &
Chr(34) & Valore & Chr(34)
                        Else
                            Valore = Replace(Valore, Chr(34), "*")
                            filtro = filtro & " and " & cmb.Tag & " like " &
Chr(34) & Valore & Chr(34)
                        End If
                    End If
                    If Tipo = "data" Then
                        filtro = filtro & " and " & cmb.Tag & "=#" &
Mid(Valore, 4, 3) & Left(Valore, 3) & Mid(Valore, 7, 4) & "#"
                    End If
                    If Tipo = "numerico" Then
                        filtro = filtro & " and " & cmb.Tag & "=" & Valore
                    End If
                    If Tipo = "errore" Then
                        MsgBox "questa applicazione ha provocato un errore
inaudito e verrà inesorabilmente terminata", vbCritical + vbOKOnly, "SEI
NELLA MERDA"
                        DoCmd.Quit
                    End If
                End If
            End If
        Next
        If Len(filtro) > 5 Then
            filtro = Right(filtro, Len(filtro) - 5)
        End If
        For Each cmb In Mask
            If cmb.ControlType = acComboBox And IsNull(cmb.Tag) = False And
cmb.Tag <> "" Then
                If filtro = "" Then
                    cmb.RowSource = "select distinct " & cmb.Tag & " from "
& Mask.RecordSource & ";"
                Else
                    cmb.RowSource = "select distinct " & cmb.Tag & " from "
& Mask.RecordSource & " where " & filtro & ";"
                End If
            End If
        Next
        Mask.FilterOn = False
        Mask.Filter = filtro
        Mask.FilterOn = True
End Sub
Private Function FindField(Lui As String) As String
        Dim tbl As TableDef
        Dim fld As dao.field
        Dim prp As Variant
        For Each tbl In CurrentDb.TableDefs
            For Each fld In tbl.Fields
                If fld.Name = Lui Then
                    Select Case fld.Type
                        Case dbDate
                            'MsgBox "data"
                            FindField = "data"
                        Case dbText
                            'MsgBox "testo"
                            FindField = "testo"
                        Case dbInteger, dbLong, dbByte, dbFloat, dbSingle,
dbDouble, dbBigInt, dbBinary, dbBoolean, dbCurrency, dbDecimal, dbNumeric
                            'MsgBox "numerico"
                            FindField = "numerico"
                        Case Else
                            'MsgBox "errore"
                            FindField = "errore"
                    End Select
                End If
            Next
        Next
End Function



 qualcuno ha voglia di testarlo per aiutarmi nel debug?
[CUT]
.... o ha voglia di fare una cosa del genere in modo piů elegante, generale
e funzionale?    (io non ci riesco)
thanks    ;-)