Problème remplissable tableau avec UserForm

Le 18/02/2025 à 11:56

bonjour à toutes et à tous.

Voici mon problème j'ai créer un userform avec date, noms et tâches, afin de remplir un tableau mensuel. Or, une popup s'ouvre pour m'indiquer un souci avec la date, du coup cela ne rempli pas le tableau. J'ai essayé de voir comment y remédier, mais je ne trouve pas la solution.

Si quelqu'un aurait la gentillesse de m'aider.

Cordialement

Jym

20tab.xlsm (35.31 Ko)
Le 18/02/2025 à 13:46

Bonjour

Remplacez :
- Le code initialize par celui-ci (plus direct)

Private Sub UserForm1_Initialize()
Dim ws As Worksheet
Dim cell As Range

' Définir la feuille contenant les noms et tâches
Set ws = ThisWorkbook.Sheets("Données")

' Charger les noms (Colonne A)
Me.cmbNom.List = ws.Range("A2:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row)

' Charger les tâches (Colonne C)
Me.cmbTache.List = ws.Range("C2:C" & ws.Cells(Rows.Count, "C").End(xlUp).Row)
End Sub

- le code de validation par celui-ci.

Cordialement

Le 18/02/2025 à 14:24

Bonjour Dan

Merci d'avoir regardé et penché sur mon sujet. J'ai remplacé le code, mais j'ai toujours ce problème de la date.

Le 18/02/2025 à 14:36

Bonjour,
Dan bonjour,

votre code recherche par exemple le 17, parce que ma date est le 17/01/2025, dans la ligne 4 de la colonne B à la colonne AF, Mais comme cette ligne est remplie par des dates, le 17 n'existe pas puisque le 01/01/2025 correspond à 45658 !

image

Ici j'ai mis en format standard les 8 premières dates de la ligne 4, donc la formule suivante ne trouve pas le 17 :
colonneJour = Application.Match(jour, ws.Range("B4:AF4"), 0) + 1

d'ailleurs cette ligne ne sert à rien, si dans mon cas j'ai mis le 17/01/2025, alors le 17 se trouve en colonne 17+1, nul besoin de faire une recherche !

De même vous faites un test >à 31, < à 1, alors que quelque ligne au dessus vous faites un test avec IsDate, si IsDate passe alors plus besoin de faire ce type de test.

Le code avec ces deux modifications :

Private Sub btnValider_Click()
    On Error GoTo GestionErreur ' Active la gestion des erreurs

    Dim ws As Worksheet
    Dim nom As String
    Dim tache As String
    Dim dateSaisie As String
    Dim jour As Variant, mois As Variant
    Dim année As Integer
    Dim cell As Range
    Dim colonneJour As Integer

    ' Vérifier que les champs ne sont pas vides
    If Me.txtDate.Value = "" Or Me.cmbNom.Value = "" Or Me.cmbTache.Value = "" Then
        MsgBox "Veuillez remplir tous les champs.", vbExclamation, "Erreur"
        Exit Sub
    End If

    ' Récupérer les valeurs du formulaire
    dateSaisie = Me.txtDate.Value
    nom = Me.cmbNom.Value
    tache = Me.cmbTache.Value

    ' Vérifier si la date est valide
    If Not IsDate(dateSaisie) Then
        MsgBox "Veuillez entrer une date valide (JJ/MM).", vbExclamation, "Erreur"
        Exit Sub
    End If

    ' Extraire le jour et le mois avec des protections supplémentaires
    jour = CInt(Split(dateSaisie, "/")(0))
    mois = CInt(Split(dateSaisie, "/")(1))

'    ' Vérifier que la date est correcte
'    If jour < 1 Or jour > 31 Or mois < 1 Or mois > 12 Then
'        MsgBox "Veuillez entrer une date valide (JJ/MM).", vbExclamation, "Erreur"
'        Exit Sub
'    End If

    ' Déterminer l'année et la feuille correspondante
    année = ThisWorkbook.Sheets("Janvier").Range("A1").Value
    Set ws = ThisWorkbook.Sheets(MonthName(mois, False)) ' Sélectionne la feuille du mois

    ' Trouver la ligne correspondant à l'agent
    Set cell = ws.Range("A:A").Find(nom, LookAt:=xlWhole)
    If cell Is Nothing Then
        MsgBox "Nom non trouvé dans le planning.", vbExclamation, "Erreur"
        Exit Sub
    End If

    ' Trouver la colonne correspondant au jour
    colonneJour = jour + 1 'Application.Match(jour, ws.Range("B4:AF4"), 0) + 1

    ' Insérer la tâche
    ws.Cells(cell.Row, colonneJour).Value = tache

    ' Surligner en jaune la cellule où la tâche est enregistrée
    ws.Cells(cell.Row, colonneJour).Interior.Color = vbYellow

    ' Réinitialiser les champs
    Me.txtDate.Value = ""
    Me.cmbNom.Value = ""
    Me.cmbTache.Value = ""

    MsgBox "Tâche enregistrée et surlignée en jaune pour le " & dateSaisie & " !", vbInformation, "Succès"

    Exit Sub ' Quitter la procédure normalement

GestionErreur:
    MsgBox "Une erreur est survenue : " & Err.Description, vbCritical, "Erreur"
    MsgBox dateSaisie

End Sub

@ bientôt

LouReeD

Le 18/02/2025 à 18:01

Re

Merci d'avoir regardé et penché sur mon sujet. J'ai remplacé le code, mais j'ai toujours ce problème de la date.

Oups... désolé je pensais avoir posté le code
Donc remplacez le code valider par celui ci-dessous

Private Sub btnValider_Click()
Dim ws As Worksheet
Dim nom As String, tache As String
Dim dateSaisie As Date
Dim jour As Variant, mois As Variant
Dim annee As Integer, colonneJour As Integer
Dim cell As Range

On Error GoTo GestionErreur ' Active la gestion des erreurs

' Vérifier que les champs ne sont pas vides
If Me.txtDate.Value = "" Or Me.cmbNom.Value = "" Or Me.cmbTache.Value = "" Then
    MsgBox "Veuillez remplir tous les champs.", vbExclamation, "Erreur"
    Exit Sub
End If

' Récupérer les valeurs du formulaire
dateSaisie = Format(Me.txtDate.Value, "dd/mm/yyyy")
nom = Me.cmbNom.Value
tache = Me.cmbTache.Value

' Vérifier si la date est valide
If Not IsDate(dateSaisie) Then
    MsgBox "Veuillez entrer une date valide (JJ/MM).", vbExclamation, "Erreur"
    Exit Sub
End If

' Extraire le jour et le mois avec des protections supplémentaires
jour = Day(dateSaisie)
mois = Month(dateSaisie)

' Vérifier que la date est correcte
If jour < 1 Or jour > 31 Or mois < 1 Or mois > 12 Then
    MsgBox "Veuillez entrer une date valide (JJ/MM).", vbExclamation, "Erreur"
    Exit Sub
End If

' Déterminer l'annee et la feuille correspondante
annee = ThisWorkbook.Sheets("Janvier").Range("A1").Value
Set ws = ThisWorkbook.Sheets(MonthName(mois, False)) ' Sélectionne la feuille du mois

' Trouver la ligne correspondant à l'agent
Set cell = ws.Range("A:A").Find(nom, LookAt:=xlWhole)
If cell Is Nothing Then
    MsgBox "Nom non trouvé dans le planning.", vbExclamation, "Erreur"
    Exit Sub
End If

' Trouver la colonne correspondant au jour
colonneJour = ws.Range("B4:AF4").Find(Format(jour, "00") & "/" & Format(mois, "00"), LookIn:=xlValues, LookAt:=xlPart).Column

' Insérer la tâche
ws.Cells(cell.Row, colonneJour).Value = tache

' Surligner en jaune la cellule où la tâche est enregistrée
ws.Cells(cell.Row, colonneJour).Interior.Color = vbYellow

' Réinitialiser les champs
Me.txtDate.Value = vbNullString
Me.cmbNom.ListIndex = -1
Me.cmbTache.ListIndex = -1

MsgBox "Tâche enregistrée et surlignée en jaune pour le " & dateSaisie & " !", vbInformation, "Succès"

Exit Sub ' Quitter la procédure normalement

GestionErreur:
MsgBox "Une erreur est survenue : " & Err.Description, vbCritical, "Erreur"
MsgBox dateSaisie
End Sub

Si ok pensez à cloturer le fil.

Cordialement

Le 19/02/2025 à 08:32

Merci à vous Dan et LouReeD pour l'aide apportée, je vais pouvoir continuer dans mon projet.

Bonne journée

Jym

Rechercher des sujets similaires à "probleme remplissable tableau userform"