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 40
| Sub InitFormsProperties(dbs As Database, wrkDefault As Workspace, cleBase As Long, DistBase As String)
Dim rst As Recordset, leForm As Form, x As Long, y As Long, strSQL As String
On Error GoTo ErrMan
Set rst = CurrentDb.OpenRecordset("SELECT [Nom], FRMUnik FROM T_Forms;")
'''Lecture ds rst des formulaires à traiter
With rst
Do While .EOF = 0
leDoc = ![Nom]
DoCmd.TransferDatabase acImport, "Microsoft Access", DistBase, acForm, leDoc, "TMP"
Set leForm = Forms("TMP") ''''Çà plante ici :(
With leForm
For x = 0 To leForm.Properties.Count - 1
strSQL = "INSERT INTO T_FormsProperties (FRMUnik, TBaseUnik, PRP_Name, PRP_Value,PRP_Value_Cible, IsGraphic) " & _
"SELECT " & !FRMUnik & ", " & cleBase & ", " & Chr(34) & ![Nom] & Chr(34) & ", " & Chr(34) & leForm.Properties(x).Name & Chr(34) & ", " & Chr(34) & leForm.Properties(x).Value & Chr(34) & ", " & Chr(34) & leForm.Properties(x).Value & Chr(34) & ", -1 ;"
Call ExecSQL(strSQL)
Suivant:
Next
End With
DoCmd.DeleteObject acForm, "TMP"
.MoveNext
Loop
.Close
End With
Set rst = Nothing
Set leForm = Nothing
Fin:
Exit Sub
ErrMan:
DoCmd.SetWarnings True
' If Err = 3219 Then Resume Suivant
' If Err = 3267 Then Resume Suivant
' If Err = 3251 Then Resume Suivant
' If Err = 3075 Then Resume Suivant
' MsgBox (Error(Err))
Resume
End Sub |
Partager