Microsoft 365 Saisie par userform ne fonctionne pas

[jcf6464]

Bonjour à vous tous et le forum,

Sur le classeur joint j'ai un souci (classeur recup sur le web mais je ne sais plus ou )

dans la feuille Data j'ai rajouter un userform pour la saisie des compétitions cela fonctionne la saisie ce fait,
Mais quand je quitte la feuille cela ne met pas à jour les feuilles hebdo et mensuel
Par contre si je saisie en manuel les infos sans passer par l'userform cela fonctionne les feuilles hebdo et mensuel ce mettent à jour,

quelqu'un peut m'expliquer le dysfonctionnement du code

bonne journée jcf

 

[vgendron]

Hello

je pense que tu as un souci de boucle dans tes deux macros "vuemois" et "vuesemaine"
tu fais "for numsem=2 to 7"
à priori, les semaines 2 à 7 sont en janvier février..

 

[vgendron]

plusieurs points

ton formulaire de saisie n'utilise pas la meme liste de nom que ce qui est autorisé dans la liste de validation de la table Data
(Jean-Clause vs Ferdinan JeanClaude)
le formulaire n'enregistre pas la date au bon format ==> il y a collision entre le format "date" mis dans les cellules du tableau, et le format "date" mis par le vba qui n'est pas une date, mais du texte..

il y a donc de la correction à faire
regarde pour ta macro vuesemaine que j'ai optimisée

Sub vuesemaine()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim jour As Range
    Dim Joueur As String
    Dim TabTS() As Variant
    
    TabTS = Sheets("Data").ListObjects(1).DataBodyRange.Value2
    With Sheets("Hebdomadaire")
        .Unprotect
        Joueur = .Range("E2")
        
        Lastline = .Range("A" & .Rows.Count).End(xlUp).Row
        If Lastline > 8 Then
            .Range("A9").Resize(Lastline - 8, 13).Clear
        End If
                
        For Each jour In .Range("masemaine")
            ligne = 9
            colonne = jour.Column
            For i = LBound(TabTS, 1) To UBound(TabTS, 1)
                If CDate(TabTS(i, 3)) = jour And TabTS(i, 2) Like Joueur & "*" Then
                    .Range("A" & ligne) = "#" & ligne - 8
                    .Cells(ligne, colonne) = TabTS(i, 1)
                    .Cells(ligne, colonne).Interior.Color = ChercheCouleur(CStr(TabTS(i, 1)))
                    '
                    ligne = ligne + 1
                End If
            Next i
        Next jour
        .Cells.WrapText = True
        .Range("E2").Select
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[jcf6464]

plusieurs points

ton formulaire de saisie n'utilise pas la meme liste de nom que ce qui est autorisé dans la liste de validation de la table Data
(Jean-Clause vs Ferdinan JeanClaude)
le formulaire n'enregistre pas la date au bon format ==> il y a collision entre le format "date" mis dans les cellules du tableau, et le format "date" mis par le vba qui n'est pas une date, mais du texte..

il y a donc de la correction à faire
regarde pour ta macro vuesemaine que j'ai optimisée

Sub vuesemaine()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim jour As Range
    Dim Joueur As String
    Dim TabTS() As Variant
   
    TabTS = Sheets("Data").ListObjects(1).DataBodyRange.Value2
    With Sheets("Hebdomadaire")
        .Unprotect
        Joueur = .Range("E2")
       
        Lastline = .Range("A" & .Rows.Count).End(xlUp).Row
        If Lastline > 8 Then
            .Range("A9").Resize(Lastline - 8, 13).Clear
        End If
               
        For Each jour In .Range("masemaine")
            ligne = 9
            colonne = jour.Column
            For i = LBound(TabTS, 1) To UBound(TabTS, 1)
                If CDate(TabTS(i, 3)) = jour And TabTS(i, 2) Like Joueur & "*" Then
                    .Range("A" & ligne) = "#" & ligne - 8
                    .Cells(ligne, colonne) = TabTS(i, 1)
                    .Cells(ligne, colonne).Interior.Color = ChercheCouleur(CStr(TabTS(i, 1)))
                    '
                    ligne = ligne + 1
                End If
            Next i
        Next jour
        .Cells.WrapText = True
        .Range("E2").Select
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Merci de ta réponse [B]vgendron[/B]
Le code ne fonctionne pas en remplacement du 1er
(ChercheCouleur) il ne trouve pas

Pour les noms c'est moi qui pas fait les rectifications dans les Parametres

Bon après midi

 

[vgendron]

ah oui pardon.. j'ai oublié de mettre la fonction cherchecouleur

Function ChercheCouleur(Compétition As String) As Long
    With Sheets("Parametres").ListObjects("T_Competitions")
        Set trouve = .Range.Find(Compétition, lookat:=xlWhole)
        If Not trouve Is Nothing Then
            ChercheCouleur = trouve.Interior.Color
        End If
    End With
End Function

 

[vgendron]

regarde la PJ
j'ai modifié la macro "VueMois"
et j'ai ajouté une feuille "ModèleMois"
plutot qu'une usine à gaz pour supprimer des lignes en fonction d'un nombre de cours.. j'ai préféré effacer tout le planning, et recopier directement la plage modèle

en ce qui concerne l'ajout de ligne entre les semaines.. i y a surement mieux à faire, déjà commencer par trier la table data par nom et par date

 

[vgendron]

ton formulaire est étrange..

deux boutons pour quitter dont un non codé.
deux boutons pour vider le formulaire (nouveau et "recycler")

le bouton modifier.. ne modifier que la dernière ligne de la table.. donc si tu rentres dans le formulaire par un double clic sur la table data, ce sera toujours la dernière ligne qui sera modifiée..

 

[vgendron]

quelques modifs ici notamment pour la sauvegarde d'une nouvelle ligne (bouton "Ajouter")
format date correctement inscrit
listes de validation à jour dans la table data, et les feuilles mensuelles et hebdo

...

 

[jcf6464]

regarde la PJ
j'ai modifié la macro "VueMois"
et j'ai ajouté une feuille "ModèleMois"
plutot qu'une usine à gaz pour supprimer des lignes en fonction d'un nombre de cours.. j'ai préféré effacer tout le planning, et recopier directement la plage modèle

en ce qui concerne l'ajout de ligne entre les semaines.. i y a surement mieux à faire, déjà commencer par trier la table data par nom et par date

Re voila ce que cela donne en bug quand on met à jour les pages hebdo et mensuel (voir photos)

pour le trie date elles sont en suivant des compétitions

A+ jcf

 

[vgendron]

regarde mon post #8, j'y ai corrigé le pb de date

 

[jcf6464]

regarde mon post #8, j'y ai corrigé le pb de date

Re très bien,
avec le changement de date que tu à fait cela fonctionne avec userform,

A+ jcf