XL pour MAC Report/MAJ de données d’un formulaire en fonction d’une sélection effectuée dans une liste déroulante

[excel2039]

Bonjour à tous,

Je suis débutant en VBA et je cherche à compléter le projet suivant.

Il s’agit d’un fichier pour noter des étudiants sans avoir à saisir de notes. Pour cela, j’ai créé une grille qui permet d’assigner une note pour chaque exercice en cliquant simplement sur une case d’option. J’ai aussi créé une liste déroulante qui permet d’afficher un nom d’étudiant ainsi qu’un bouton d’initialisation qui remet à zéro les cases d’option. (cf. fichier joint « Notes_prototype_V1 »)

J’aimerais maintenant activer deux autres boutons dont voici la description du fonctionnement souhaité :

- « Sauvegarder » : 1/ on sélectionne un étudiant grâce à la liste déroulante ; 2/ on assigne des notes avec les cases d’option ; 3/ en cliquant sur « Sauvegarder », on reporte toutes les notes de cet étudiant dans la liste située dans une feuille adjacente, ici nommée « Matrice ».

- « Charger » : 1/ on sélectionne un étudiant, qui a déjà obtenu une note, grâce à la liste déroulante ; 2/ en cliquant sur « Charger », on affiche toutes les notes de cet étudiant (ainsi que l’état des cases d’option) à partir des données enregistrées dans « Matrice » (pour une possible mise à jour).

J’espère avoir été assez clair, et d’avance merci pour votre aide!

 

[sylvanu]

Bonjour Excel2039 et bienvenu sur XLD,
Un essai en PJ avc :

    Sub Sauvegarder()
    Dim Col%, L%
    On Error Resume Next
    With Sheets("Matrice")
        Ligne = Application.Match([B2], .[B:B], 0)
        If Ligne = 0 Then Exit Sub              ' Nom non trouvé
        Col = 3
        For L = 2 To 14 Step 2
            .Cells(Ligne, Col) = Cells(L, "A")  ' Collage infos
            Col = Col + 1
        Next L
    End With
End Sub
Sub Charger()
    Dim Col%, L%
    On Error Resume Next
    With Sheets("Matrice")
        Ligne = Application.Match([B2], .[B:B], 0)
        If Ligne = 0 Then Exit Sub              ' Nom non trouvé
        Col = 3
        For L = 2 To 14 Step 2
            Select Case .Cells(Ligne, Col)
                Case 0: Cells(L, "F") = 1
                Case 0.5: Cells(L, "F") = 2
                Case 1: Cells(L, "F") = 3
            End Select
            Col = Col + 1
        Next L
    End With
End Sub

pour simplifier le code, j'ai insérer une ligne en 3, donc les notes sont une ligne sur 2, le transfert est plus simple.

 

[patricktoulon]

Bonjour à tous les deux

@sylvanu
allons!!???😳

 On Error Resume Next
    With Sheets("Matrice")
        Ligne = Application.Match([B2], .[B:B], 0)
        If Ligne = 0 Then Exit Sub              ' Nom non trouvé

match n'ayant pas de gestion d'erreur la ligne on error resume next fait son job
donc des la ligne match on sort
en fait la ligne if ligne=0 n'est pas exécutée si pas de match donc inutile
on a bien un moyen car le membre application en a une de gestion d'erreur

conclusion
voilà comment je ferais

Sub Sauvegarder()
    Dim col%, L%, Notes
    'on récupere les notes dans l'ordre des colonne de matrice dans l'array
    Notes = Array([A2], [A3], [A5], [A7], [A9], [A11], [A13])

    With Sheets("Matrice")
        'on choppe la ligne en gérant l'erreur en amont in one line en gros on remplace l'erreur par zero
        ligne = Application.IfError(Application.Match([b2].Value, .[B:B], 0), 0)
        If ligne = 0 Then Exit Sub              ' Nom non trouvé (là oui cette ligne est utile)
        .Cells(ligne, 3).Resize(, UBound(Notes) + 1) = Notes    ' on injecte dans la ligne correspondnate dans matrice
    End With
End Sub

Sub Charger()
    Dim col%, L%, Notes
    With Sheets("Matrice")
        'on gere l'erreur de match en amont in one line (en gros on remplace l'erreur par zero)
        ligne = Application.IfError(Application.Match(Feuil1.[b2].Value, .[B:B], 0), 0)
        If ligne = 0 Then Exit Sub              ' Nom non trouvé

        'on ne recupere que les exercice 1a 1b 2a 2b
        Notes = Application.Index(.[C1:I1000].Value, ligne, Array(3, 4, 6, 7))

        'on les place dans F5,F7  et  F11,F13 avec un switch de convertion  0.5=1 : 1=2 :  2=3

        [F5] = Switch(Notes(1) = 0, 1, Notes(1) = 0.5, 2, Notes(1) = 1, 3)
        [F7] = Switch(Notes(2) = 0, 1, Notes(2) = 0.5, 2, Notes(2) = 1, 3)
        [F11] = Switch(Notes(3) = 0, 1, Notes(3) = 0.5, 2, Notes(3) = 1, 3)
        [F13] = Switch(Notes(4) = 0, 1, Notes(4) = 0.5, 2, Notes(4) = 1, 3)

    End With
End Sub

Public Sub Reinitialiser()
'Reinitialise tous les critres
'ici on  efface tout simplement
    [F3:F13].ClearContents: [b2] = ""
End Sub

 

[sylvanu]

Bonjour Patricktoulon,
S'il y a erreur sur Match, sans cette ligne le code continue le transfert ( sans rien transférer puisqu'il a erreur) d'où perte de temps.
Avec cette ligne, si non trouvé on sort. Tout simplement.

 

[patricktoulon]

re
oui par ce que tu a on error resume next
sauf que tu le fait 10 fois, 20 fois ; tu ne vide jamais le stack d'erreur
comment pourrais tu le faire puisque tu exit sub

au mieux
a la place de ta ligne if ligne=0
je ferais
if err.number>0 then on error goto 0:exit sub 'on vide le stack d'erreur et on exit

mais perso je préfère tester ligne en tant que vrai zero d'ou
ligne = Application.IfError(Application.Match([b2].Value, .[B:B], 0), 0)
si pas de match ligne = vraiment zero

 

[sylvanu]

RE,
Pour moi la stack error est vidée à la sortie de la routine. C'est comme ça que je l'avais interprétée ( Lien ) :

un gestionnaire d’erreurs est automatiquement désactivé lorsqu’une procédure est quittée.

 

[patricktoulon]

re
déactivé ne veux pas dire tampon déchargé
il faut le goto 0

 

[excel2039]

Bonjour à tous les deux,

Merci beaucoup pour vos propositions!

Cela m'a pris un certain temps pour comprendre la logique de celles-ci. Je ne suis pas compétent pour juger s'il en y une meilleure que l'autre, mais il apparaît que la proposition de Patrick est la plus simple pour moi à manipuler, et donc à adapter à mon fichier final qui est légèrement plus complexe et étendu que le fichier que je vous ai envoyé.

Encore une fois, je vous remercie pour votre aide, tout en saluant votre passion et générosité!