[XL 365] VBA - Formulaire, validation des données du formulaire + ajout d'une ligne dans un tableau

Hello à toutes et à tous,

L'idée est assez simple et pourtant je sèche... Ça fait depuis ce matin que je rafistole mon bout de code. Je n'ai pas de deadline, c'est pour mon activité de salarié, mais j'aimerai avant tout comprendre et apprendre :

J'ai un tableau de suivi de mon activité pro (prise de rdv) niveau formule, je n'ai pas de problème, j'ai réussi à faire ce que je voulais. C'est au niveau du formulaire que je sèche.

Certes je peux utiliser le formulaire de données intégré à XL, mais je veux simplifier le process pour mes collègues qui sont allergiques à XL.

J'ai donc créé un formulaire VBA pour alimenter un tableau (dans l'onglet BDD), mais c'est là que je sèche : toutes mes tentatives ont été vaines.

En pièce jointe le fichier (sans données évidemment), 3 sheets : Suivi des RDV, BDD et paramètres.

Pièce jointe 647313

Ci-dessous le code que j'ai réussi à pondre avec mes recherches google.

Code:

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
 
'Ouverture du formulaire
Private Sub UserForm1_Initialize()
 
 
End Sub
 
Private Sub CB_Propo_Change()
 
End Sub
 
'Bouton Ajouter un RDV
Private Sub CommandButton1_Click()
 
    Dim Ws As Worksheet
    Set Ws = Sheets(BDD).ListObjects("Tableau3")
 
    'On Passe tous les labels en Noir
    Label_Date.ForeColor = &H80000012
    Label_Mois.ForeColor = &H80000012
    Label_TypeRDV.ForeColor = &H80000012
    Label_NomPrénom.ForeColor = &H80000012
    Label_Source.ForeColor = &H80000012
    Label_Agent.ForeColor = &H80000012
    Label_StatutRDV.ForeColor = &H80000012
    Label_R2pos.ForeColor = &H80000012
    Label_propo.ForeColor = &H80000012
    Label_prod.ForeColor = &H80000012
    Label_reco.ForeColor = &H80000012
    Label_prev.ForeColor = &H80000012
    Label_confirm.ForeColor = &H80000012
    Label_replacé.ForeColor = &H80000012
 
 
    'On vérifie que les champs nécessaires à une entrée soient remplis et on colorie en rouge si ce n'est pas le cas
    If TB_Date <> "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Mois <> "" Then
        Label_Mois.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Type <> "" Then
        Label_TypeRDV.ForeColor = RGB(255, 0, 0)
    ElseIf TB_Nomprenom <> "" Then
        Label_NomPrénom.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Source <> "" Then
        Label_Source.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Agent <> "" Then
        Label_Agent.ForeColor = RGB(255, 0, 0)
    Else
 
        Dim L As Long
 
        L = Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row - 1 'Pour placer le nouvel enregistrement à la première ligne de tableau non vide
 
        Cells(L, 1).Value = TB_Date
        Cells(L, 2).Value = CB_Mois
        Cells(L, 3).Value = CB_Type
        Cells(L, 4).Value = TB_Nomprenom
        Cells(L, 5).Value = CB_Source
        Cells(L, 6).Value = CB_Agent
        Cells(L, 7).Value = CB_Staut
        Cells(L, 8).Value = CB_R2pos
        Cells(L, 9).Value = CB_Propo
        Cells(L, 10).Value = TB_Prod
        Cells(L, 12).Value = Tb_Reco
        Cells(L, 13).Value = TB_Prev
        Cells(L, 14).Value = CB_Confirm
        Cells(L, 15).Value = CB_Replace
 
    End If
 
    Unload Me
 
End Sub

Ce que j'ai déjà fait :

1/ la structure du résumé de l'activité via formules (que je vous laisse en clair)
2/ Le tableau base de données qui reprend chacun des rdvs
3/ Le suivi mensuel
4/ Le suivi Annuel
5/ L'exportation en PDF via un bouton (macro)

Là où je sèche:

1/ La vérification des champs à remplir ne fonctionne pas : ils ne se mettent pas en rouge quand ils ne sont pas remplis.
2/ aucune entrée ne se fait dans l'onglet BDD dans Tableau3 suite à l'utilisation du formulaire.

Là où je voudrais aller :

Outre les points 1 et 2 cités plus haut :

1/ rechercher modifier des entrées du tableau en recherchant avec au minimum 2 critères : Date et nom, et une fois l'entrée trouver complêter les données manquantes

En gras : là où j'ai besoin de votre aide pour y voir plus clair
En souligné : là où j'aurais besoin de vos conseils et essayer de trouver la solution (j'ai envie de comprendre et apprendre)

Note à moi-même : dans le tableau3, BDD, ajouter une condition à la validation de donnée : si contient l'année ne proposer que l'année concernée (je pense réussir tout seul ce point pour l'instant)

Je sollicite votre aide bienveillante et votre expertise.

Vous remerciant par avance du temps que vous m'accorderez.

Bien à vous.

[EDIT] : J'ai réussi à avancer.

1/ Création d'un module pour l'affecter au bouton macro sur ma feuille "suivi RDV"

Code:

1
2
3
4
5
 
 
Sub AfficherFormulaire()
    UserForm1.Show
End Sub

2/ sur le bouton nouveau RDV, remplacement du code par celui ci :

Code:

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
 
Private Sub CommandButton1_Click()
 
    'On vérifie que les champs nécessaires à une entrée soient remplis et on colorie en rouge si ce n'est pas le cas
    If IsDate(TB_Date) Then
 
    Else
 
        MsgBox "Merci d'indiquer une date correcte"
 
    End If
 
    If CB_Mois <> "" Then
        Label_Mois.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Type <> "" Then
        Label_TypeRDV.ForeColor = RGB(255, 0, 0)
    ElseIf TB_Nomprenom <> "" Then
        Label_NomPrenom.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Source <> "" Then
        Label_Source.ForeColor = RGB(255, 0, 0)
    ElseIf CB_Agent <> "" Then
        Label_Agent.ForeColor = RGB(255, 0, 0)
    Else
        MsgBox "Merci de remplir tout les chanps avec une asterisque (*)"
 
    End If
 
    If Me.CB_Mois.ListIndex = -1 Then
    ElseIf Me.CB_Type.ListIndex = -1 Then
    ElseIf Me.CB_Source.ListIndex = -1 Then
    ElseIf Me.CB_Agent.ListIndex = -1 Then
    ElseIf Me.CB_Statut.ListIndex = -1 Then
    ElseIf Me.CB_R2.ListIndex = -1 Then
    ElseIf Me.CB_Propo.ListIndex = -1 Then
    ElseIf Me.CB_Confirm.ListIndex = -1 Then
    ElseIf Me.CB_Replace.ListIndex = -1 Then
 
        MsgBox "Veuillez sélectionner une valeur valide dans la liste déroulante.", vbExclamation
        Exit Sub
    End If
 
    'Affichage du débug
    Debug.Print "Début de la procédure btnValider_Click"
 
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("BDD")
 
    ' Dernière ligne utilisée dans la colonne A
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
 
    ' Afficher la dernière ligne utilisée
    Debug.Print "Dernière ligne utilisée : " & lastRow
 
    ' Remplir les données dans la feuille "BDD"
    ws.Cells(lastRow, 1).Value = Me.TB_Date.Value
    Debug.Print "Date ajoutée : " & Me.TB_Date.Value
    ws.Cells(lastRow, 2).Value = Me.CB_Mois.Value
    Debug.Print "Date ajoutée : " & Me.CB_Mois.Value
    ws.Cells(lastRow, 3).Value = Me.CB_Type.Value
    Debug.Print "Date ajoutée : " & Me.CB_Type.Value
    ws.Cells(lastRow, 4).Value = Me.TB_Nomprenom.Value
    Debug.Print "Date ajoutée : " & Me.TB_Nomprenom.Value
    ws.Cells(lastRow, 5).Value = Me.CB_Source.Value
    Debug.Print "Date ajoutée : " & Me.CB_Source.Value
    ws.Cells(lastRow, 6).Value = Me.CB_Agent.Value
    Debug.Print "Date ajoutée : " & Me.CB_Agent.Value
    ws.Cells(lastRow, 7).Value = Me.CB_Statut.Value
    Debug.Print "Date ajoutée : " & Me.CB_Statut.Value
    ws.Cells(lastRow, 8).Value = Me.CB_R2.Value
    Debug.Print "Date ajoutée : " & Me.CB_R2.Value
    ws.Cells(lastRow, 9).Value = Me.CB_Propo.Value
    Debug.Print "Date ajoutée : " & Me.CB_Propo.Value
    ws.Cells(lastRow, 10).Value = Me.TB_Prod.Value
    Debug.Print "Date ajoutée : " & Me.TB_Prod.Value
    ws.Cells(lastRow, 11).Value = Me.Tb_Reco.Value
    Debug.Print "Date ajoutée : " & Me.Tb_Reco.Value
    ws.Cells(lastRow, 12).Value = Me.TB_Prev.Value
    Debug.Print "Date ajoutée : " & Me.TB_Prev.Value
    ws.Cells(lastRow, 13).Value = Me.CB_Confirm.Value
    Debug.Print "Date ajoutée : " & Me.CB_Confirm.Value
    ws.Cells(lastRow, 14).Value = Me.CB_Replace.Value
    Debug.Print "Date ajoutée : " & Me.CB_Replace.Value
 
    ' Fermer le formulaire
    Unload Me
 
Debug.Print "Fin de la procédure btnValider_Click"
 
End Sub

Le debug m'a été utile pour voir où étaient mes erreurs...

L'ajout se fait bien dans le tableau, mais même si j'ai bien la msgbox, l'entrée erronée se fait tout de même dans le formulaire.

Je continue de chercher, mais si une âme charitable peut me mettre sur la voie, je suis preneur :)