1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
| Option Compare Database
Option Explicit
Sub MajListe()
On Error GoTo GestionErreurs
Dim frm As AccessObject
Dim ctl As Control
Dim sSql As String
'Vidanger la table
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM Liste;"
'Explorer dans chaque formulaire les controles qui ont une propriété "légende"(caption)
For Each frm In CurrentProject.AllForms
DoCmd.OpenForm frm.Name
For Each ctl In Forms(frm.Name).Controls
sSql = "INSERT INTO Liste ( appli,FormulaireNom,FormulaireLegende,ControleNom,ControleLegende) select '" _
& CurrentProject.Name & "' as expr1, '" _
& frm.Name & "' AS Expr2, '" _
& Forms(frm.Name).Caption & "' As Expr3, '" _
& ctl.Name & "' As Expr4, '" _
& ctl.Caption & "' As Expr5;"
DoCmd.RunSQL sSql
PasLegende:
Next ctl
DoCmd.Close acForm, frm.Name
Next frm
DoCmd.SetWarnings True
Exit Sub
GestionErreurs:
Select Case Err.Number
Case 438 ' ne concerne pas cet objet
Resume PasLegende
Case Else
MsgBox Err.Number & " " & Err.Description
End Select
End Sub |