openaccess/test/source/modules/Liens.bas

Option Compare Database

Public Function get_lien(ByVal Nom As String, Optional mode As String = "*") As String
On Error GoTo err_lien
Dim filtre As String
 
    filtre = "[nom]='" & Nom & "' AND [mode] like '" & mode & "'"
    'If Len(mode) > 0 Then filtre = filtre & " AND [mode] like '" & mode & "'"
    
    get_lien = DFirst("lien", "ztbl_liens", filtre)


fin:
    Exit Function
err_lien:
    If err.Number = 94 Then
        MsgBox "Le lien vers '" & Nom & "' (mode '" & mode & "') n'existe pas dans ztbl_liens", vbCritical
    Else
        MsgBox "Impossible de trouver le lien '" & Nom & "' (mode '" & mode & "'):" & vbNewLine & err.Description, vbCritical
    End If
End Function


'temp: pour trouver les logos
Sub list_images()
Dim str As String

forms:
For Each frm In Application.CurrentProject.AllForms
    DoCmd.OpenForm frm.Name, acDesign, , , , acHidden
    str = ""
    For Each ctl In forms(frm.Name).Controls
        If ctl.ControlType = acImage Then
            str = str & ctl.Name & ",   "
        End If
    Next ctl
    If Len(str) > 0 Then Debug.Print frm.Name, str
    DoCmd.Close acForm, frm.Name, acSaveNo
Next frm

etats:
For Each rpt In Application.CurrentProject.AllReports
    DoCmd.OpenReport rpt.Name, acViewDesign, , , acHidden
    str = ""
    For Each ctl In Reports(rpt.Name).Controls
        If ctl.ControlType = acImage Then
            str = str & ctl.Name & ",   "
        End If
    Next ctl
    If Len(str) > 0 Then Debug.Print rpt.Name, str
    DoCmd.Close acReport, rpt.Name, acSaveNo
Next rpt

End Sub