{Access} récupérer valeur liste -> VBA [Résolu]

Dim MonCtl As Control
Dim Element As Variant
Set MonCtl = Forms!nom_du_formulaire!Nom_de_la_liste
For Each Element In MonCtl.ItemsSelected
    MsgBox MonCtl.Column(0, Element)
Next

MsgBox MonCtl.Column(0, Element)

MsgBox MonCtl.Column(2, Element)

Private Sub ID_COULEUR_Exit(Cancel As Integer)
Dim ID As Variant
ID = Forms!F_AFFECTATION!ID_VOITURE
MsgBox ID 'vérif
Dim MonCtl As Control
Dim Element As Variant
Dim Suite As String
Set MonCtl = Forms![F_AFFECTATION]![ID_COULEUR]
For Each Element In MonCtl.ItemsSelected
    MsgBox MonCtl.Column(2, Element) 'vérif
    Suite = Suite + MonCtl.Column(2, Element) + "; "
Next
MsgBox Suite 'vérif

Private Sub Commande0_Click()
Dim T As DAO.TableDef
Dim F As DAO.Field
Dim P As DAO.Property
Set base = CurrentDb()
'Set T = CurrentDb.TableDef("T_couleurs")
For Each T In CurrentDb.TableDefs
    If T.Name = "T_couleurs" Then
        For Each F In T.Fields
            For Each P In F.Properties
                MsgBox "Champ " & F.Name & " - Attribut : " & P.Name & ", Valeur = " & LitProp(F, P.Name)
            Next
        Next
    End If
Next
End Sub
Private Function LitProp(Objet As Object, Propriete As String) As String
On Error GoTo err:
LitProp = Objet.Properties(Propriete)
err:
End Function

Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Set tbl = CurrentDb.CreateTableDef("Temp")
Set tdf = CurrentDb.TableDefs("Temp")

tdf.Field.Append tdf.CreateField("id_temp", dbLong)  'erreur 3420 objet incorrect ou non défini??
tdf.Field.Append tdf.CreateField("color_temp", dbText, 200)
tdf!id_temp.Properties.Append tdf.CreateProperty("RowSource", dbLong, ID)
tdf!color_temp.Properties.Append tdf.CreateProperty("RowSource", dbText, Suite)

Dim ID As Variant
ID = Forms!F_AFFECTATION!ID_VOITURE
MsgBox ID 'vérif
Dim base As DAO.Database
Set base = CurrentDb()
Dim MonCtl As Control
Dim MaListe As ListBox
Dim Element As Variant
Dim Suite As String
Set MonCtl = Forms![F_AFFECTATION]![ID_COULEUR]
For Each Element In MonCtl.ItemsSelected
    MsgBox MonCtl.Column(2, Element) 'vérif
    Suite = Suite + MonCtl.Column(2, Element) + "; "
Next
MsgBox Suite 'vérif


Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Set tdf = base.CreateTableDef("Temp")
Set fld = tdf.CreateField("id_temp", dbLong)
        fld.OrdinalPosition = 1
        fld.DefaultValue = ID 'ne marche pas
        tdf.Fields.Append fld
Set fld = tdf.CreateField("color_temp", dbText)
        fld.OrdinalPosition = 2
        fld.Size = 255
        fld.Required = True
        fld.AllowZeroLength = False
        fld.DefaultValue = Suite 'ne marche pas
        tdf.Fields.Append fld
MsgBox "La table " & fld.DefaultValue & " a été créée"

Dim T As DAO.TableDef
Dim F As DAO.Field
Dim P As DAO.Property
Set T = CurrentDb.TableDefs("T_NEUVES")
For Each T In CurrentDb.TableDefs
    If T.Name = "T_NEUVES" Then
        For Each F In T.Fields
            If F.Name = "COULEUR_NEUVE" Then
                For Each P In F.Properties
                    If P.Name = "RowSource" Then
                        T!COULEUR_NEUVE.Properties.Append T.CreateProperty("RowSource", dbText, "SELECT color_temp FROM Temp WHERE id_temp = ID_NEUVE;")
                    End If
                Next
            End If
        Next
    End If
Next

Set fld = Nothing
Set tdf = Nothing
Set T = Nothing
Set F = Nothing
Set P = Nothing

For Each T In CurrentDb.TableDefs
    If T.Name = "T_NEUVES" Then
        For Each F In T.Fields
            If F.Name = "ID_NEUVE" Then
                If F.Value = ID Then                      //FAUX
                    If F.Name = "COULEUR_NEUVE" Then
                        For Each P In F.Properties
                            If P.Name = "RowSource" Then
                                T!COULEUR_NEUVE.Properties.Append T.CreateProperty("RowSource", dbText, Suite)
                            End If
                        Next
                    End If
                End If
            End If
        Next
    End If
Next