Newsgroup: it.comp.appl.access
Titolo: Elenco degli oggetti che fanno riferimento ad una tabella o query

Alcune settimane fa sono stati postati alcuni messaggi che trattavano di una
procedura che faccia un elenco degli oggetti (maschere, controlli,
reports...) che fanno riferimento ad una tabella o o ad una query.
Potreste rimandare il codice?
Ciao e grazie
Paolo


Ecco il segugio:
Public Function Segugio(Nome As String, Optional dettagli As Boolean)
As Boolean
'serve per verificare se una query o tabella e' usata in una form o in
un Report
'se si imposta dettagli a true, vengono elencati form e report
contenenti la stringa
On Error GoTo annulla
Dim ro As Recordset
Dim f As Variant
Dim m As Module
Dim qdf As QueryDef
Dim str As String
Dim intL As Integer
Dim intP As Integer
'Dim intMas As Integer 'Serve per riaprire le maschere
'Dim strMasAp() As String 'Serve per riaprire le maschere
Segugio = False
Set ro = CurrentDb.OpenRecordset("SELECT Name, Type FROM MSysObjects
WHERE Flags = 0;", dbOpenSnapshot)
ro.MoveFirst
DoCmd.Echo False
DoCmd.SetWarnings False
'intMas = MaschereAperte(strMasAp) 'Serve per riaprire le maschere
Do Until ro.EOF
    Select Case ro!Type
        Case -32768 'form
            DoCmd.OpenForm ro!Name, acDesign, , , , acHidden
            Set f = Forms(ro!Name)
            If TrovaStringa(Nome, f.RecordSource) Or TrovaDentro(Nome,
Forms(ro!Name)) Then
                Segugio = True
                If dettagli Then Debug.Print "Form " & ro!Name & vbCr;
Else GoTo esci
            End If
            If f.HasModule Then
                Set m = f.Module
                If TrovaNelModulo(m, Nome) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Modulo di classe
della form " & ro!Name & vbCr; Else GoTo esci
                End If
            End If
            DoCmd.Close acForm, ro!Name, acSaveNo
        Case -32764 'report
            DoCmd.OpenReport ro!Name, acViewDesign
            Set f = Reports(ro!Name)
            If TrovaStringa(Nome, f.RecordSource) Then
                Segugio = True
                If dettagli Then Debug.Print "Report " & ro!Name &
vbCr; Else GoTo esci
            End If
            If f.HasModule Then
                Set m = f.Module
                If TrovaNelModulo(m, Nome) Then
                    Segugio = True
                    If dettagli Then Debug.Print "Modulo di classe del
report " & ro!Name & vbCr; Else GoTo esci
                End If
            End If
            DoCmd.Close acReport, ro!Name, acSaveNo
        Case -32761 'moduli
            DoCmd.OpenModule ro!Name
            Set m = Modules(ro!Name)
            If TrovaNelModulo(m, Nome) Then
                Segugio = True
                If dettagli Then Debug.Print "Modulo " & ro!Name &
vbCr; Else GoTo esci
            End If
            DoCmd.Close acModule, ro!Name, acSaveNo
        Case 5 'query
            Set qdf = CurrentDb.QueryDefs(ro!Name)
            intP = InStr(1, qdf.SQL, "FROM", vbTextCompare) + 5
            If InStr(1, qdf.SQL, "WHERE", vbTextCompare) > 0 Then
                intL = InStr(1, qdf.SQL, "WHERE", vbTextCompare) -
(InStr(1, qdf.SQL, "FROM", vbTextCompare) + 5)
            Else
                intL = Len(qdf.SQL) - (InStr(1, qdf.SQL, "FROM",
vbTextCompare) + 5)
            End If
            str = Mid(qdf.SQL, intP, intL)
            If TrovaStringa(Nome, str) Then
                Segugio = True
                If dettagli Then Debug.Print "Query " & ro!Name &
vbCr; Else GoTo esci
            End If
        Case Else
    End Select
    ro.MoveNext
Loop
esci:
DoCmd.Echo True
DoCmd.SetWarnings True
Set ro = Nothing
Set f = Nothing
Set m = Nothing
Set qdf = Nothing
'Serve per riaprire le maschere
'If intMas > 0 Then
'    For intL = 1 To intMas
'        DoCmd.OpenForm strMasAp(intL, 1), , , strMasAp(intL, 2)
'    Next
'End If
Exit Function
annulla:
MsgBox "Si è verificato un errore (" & Err.Number & ")" &
Error(Err.Number), vbCritical + vbOKOnly, "Errore"
Resume esci
End Function
Public Function TrovaStringa(parte As String, stringa As String) As
Boolean
    TrovaStringa = InStr(1, stringa, parte)
End Function
Public Function MaschereAperte(str() As String) As Integer 'Serve per
riaprire le maschere
Dim fm As Form
    MaschereAperte = 0
    ReDim str(Forms.Count, 2)
    For Each fm In Forms
        MaschereAperte = MaschereAperte + 1
        str(MaschereAperte, 1) = fm.Name
        str(MaschereAperte, 2) = fm.Filter
    Next
End Function
Public Function TrovaDentro(Nome As String, f As Form) As Boolean
Dim ctl As Control
TrovaDentro = False
For Each ctl In f
    If ctl.ControlType = acListBox Or ctl.ControlType = acComboBox
Then
        If ctl.RowSourceType = "Table/query" Then TrovaDentro =
TrovaStringa(Nome, ctl.RowSource) Or TrovaDentro
    End If
Next
End Function
Public Function TrovaNelModulo(m As Module, s As String) As Boolean
'ricerca la stringa s nel modulo m
'On Error GoTo annulla
Dim ri As Long, ci As Long, rf As Long, cf As Long
Dim strSinistra As String, strDestra As String
TrovaNelModulo = m.Find(s, ri, ci, rf, cf)
esci:
Exit Function
annulla:
'MsgBox Err & ": " & Err.Description
TrovaNelModulo = False
Resume esci
End Function
--
Lorenzo Coronati
--
<<Nessuno sa che questa affermazione e' vera>>
(John D. Barrow)
--

 un Report
Grazie mille! Devo modificare un'applicazione. Questa funzione mi sarà
utilissima!
Ciao
Paolo

utilissima!
Posta la partita iva, che io e sib ti mandiamo la fattura ;-)



Ecco!! Questa si' che e' una buona idea!!!
Comunque, per me, la funza e' cotta. Non s'impalla e pare proprio efficace.
Solo una cosa mi lascia perplesso, tu dici che e' superflua la sub per
riaprire le maschere (e ti ringrazio di averla solo "apostrofata", ma mi
succede che anche cosi', non mi chiude la finestra di dialogo da cui la
avvio, te lo spieghi?
In ogni caso, si puo' mandare.
Ciao, Sib
--
------------------------------------------------------
Non e' grave non capire; grave e' occuparsi di cio' che non si capisce.
Ma ricordate anche che il saggio egizio Ptahhotep scrisse:
"... perche' non esistono saggi per nascita."
------------------------------------------------------
Saturiamo ECHELON:
bomba saddam attentato medio oriente

avvio, te lo spieghi?
Boh, io la chiamo da debug.
Baibai


 Baibai
Anche io, ho perņ qualche problema con le maschere basate su sql con
passaggio di parametri!!
Capisco che la perfezione non esiste, perņ dato che non hai nulla da fare
perfezionalo sto canuccio!! ;-)
Ciao RoDAgo :-)

 wrote in message
01bf66b7$07192540$LocalHost@besson-elisabet...

In che senso problema?
Ciao, Sib
PS Mi faro' sentire quanto prima :-)


 PS Mi faro' sentire quanto prima :-)ù
Se l'sql su cui e basata la Form pretende come parametro un valore che è
presente in un'altra form la segugio si brocca!
Cmq è una stupidaggine che si può facilmente risolvere!!
Ciao RoDAgo :-)