INFORMATIQUE

Accueil site > Accueil applications informatique > Accueil Access
Accueil Exemples divers

Imaginez faire un copier/coller du net dans un contrôle de votre base Access2003 avec des noms d'acteurs jouant dans un film et ayant comme séparateur une virgule et un espace...

Exemple :
Dans le film "American History X" les Acteurs sont : Edward Norton, Edward Furlong, Fairuza Balk, Beverly D'Angelo, Avery Brooks, Stacy

Et vous voulez entrer chaque acteur dans un enregistrement spécifique à chacun suivant le film...

Créer :

1/ Une table "T_Cine" avec comme champs :
      NumFilm (NumAuto)
      Acteurs (Mémo)
2/ Une table "T_Acteurs" avec comme champs :
      NomActeurs (Texte)
3/ Une table "T_ActeurFilm" avec comme champs :
      NomActeur (Texte)
      NumFilm (Numérique)
4/ Un formulaire "F-Cine" basé sur "T_Cine" avec comme contrôles :
      Acteurs
      NumFilm
      ListeActeurs (Zone de liste) :

SELECT T_ActeursFilm.NumFilm, T_ActeursFilm.NomActeur FROM T_ActeursFilm WHERE (((T_ActeursFilm.NumFilm)=[Forms]![F_Cine]![NumFilm])) ORDER BY T_ActeursFilm.NomActeur;

      BtnTrier (Bouton) avec en code évènement sur Click :

Private Sub BtnTrier_Click()
    Me.ListeActeurs.BackColor = RGB(255, 0, 0)
    DoCmd.SetWarnings False
    Dim StrSql As String
    Dim MonTab() As String
    Dim MonInd As Integer
    On Error GoTo Err_BtnTrier_Click
    If Nz(Acteurs, "") = "" Then
        MsgBox "Il n'y a pas d'acteurs enregistrés.", vbExclamation, "Tri des acteurs"
    Else
        StrSql = "DELETE T_ActeursFilm.* " & _
            "FROM T_ActeursFilm " & _
            "WHERE T_ActeursFilm.NumFilm = " & Me.NumFilm & ";"
        CurrentDb.Execute StrSql

        'Coupe au séparateur "virgule+espace"les enregistrements du contrôle "Acteurs" du formulaire
        'Fait un "tableau" avec chaque élément trouvé
        ' Tri et ajoute les enregistrements à la T_Acteurs

        MonTab = Split(Acteurs, ", ")
        For MonInd = 0 To UBound(MonTab)
            CurrentDb.Execute "INSERT INTO [T_Acteurs] (NomActeur) " _
            & "VALUES ('" & Replace(MonTab(MonInd), "'", "''") & "');"
        Next

        StrSql = "INSERT " & _
            "INTO T_ActeursFilm ( NomActeur, NumFilm ) SELECT T_Acteurs.NomActeur, " & Me.NumFilm & _
            " AS Fiche " & _
            " FROM T_Acteurs;"
        CurrentDb.Execute StrSql
        StrSql = "DELETE * FROM T_Acteurs;"
        CurrentDb.Execute StrSql
        ListeActeurs.Requery
    End If
Exit_BtnTrier_Click:
    Me.ListeActeurs.BackColor = 16777164
    DoCmd.SetWarnings True
    Exit Sub

Err_BtnTrier_Click:
    MsgBox Error$ & " " & Err
    Resume Exit_BtnTrier_Click
End Sub


Le tour est joué grâce à ce groupe de News d'access et pas mal de participants et la
précieuse collaboration de Raymond pour le final...
A faire partager...