Création planning

Bonjour à vous,

un petit soucis au niveau de la création d'un planning :

Voici mon problème :

je commence par rentrer une date de début de stage et une date de fin de stage grâce a un inputbox.

je souhaite que toutes les dates entre ces deux jours soit mise dans mon tableau et que l'on cache les week-end et le vendredi aprem.

jusque là pas de problème. mon soucis est que la date de fin n'est pas reconnu et le code continu à l'infini. (et pourtant lors de sa création cela marchait).

Voici le code :

Sub Date_CC()

Dim cel As Range
Dim débutCC As Variant, finCC As Variant, jour As Date
Dim m As Long, k As Integer, dercol As Integer, derlig As Integer
Dim sh As Worksheet, mdp As Variant

Set sh = ActiveSheet

Application.ScreenUpdating = False

Range("E6").Select

débutCC = Format(InputBox("A quelle Date commence les Cas Concrets ?", "Date de début des cas concrets"), "dd/mm/yy") 'demande à l'utilisateur la date des 1er CC, le format date est automatiquement appliqué
If débutCC = "" Or Not IsDate(débutCC) Then
    Application.ScreenUpdating = True
    sh.Protect Password:=mdp
    Exit Sub                'si ce n'est pas une date ou vide on quitte la macro
End If

finCC = Format(InputBox("A quelle Date fini les Cas Concrets ?", "Date de fin des cas concrets"), "dd/mm/yy")  'demande à l'utilisateur la date des derniers CC, le format date est automatiquement appliqué

If finCC = "" Then
Application.ScreenUpdating = True
sh.Protect Password:=mdp
Exit Sub                                         ''si ce n'est pas une date ou vide on quitte la macro
End If

If Not IsDate(débutCC) Or Not IsDate(finCC) Then            'les données saisi doivent être des dates
Application.ScreenUpdating = True
sh.Protect Password:=mdp
Exit Sub
Else

Range("E6").Value = Format(débutCC, "dd - mmm")             'on impose le même format de date aux valeurs concernées
        derlig = Cells(Rows.Count, 3).End(xlUp).Row
            For m = 1 To derlig
                If Cells(m, 3) = "0" Then
                    Cells(m, 3).Rows.EntireRow.Hidden = True
                End If
            Next

débutCC = Format(débutCC, "dd - mmm")
finCC = Format(finCC, "dd - mmm")

Do Until ActiveCell.Value = finCC                           'on boucle tant que la date finCC n'est pas saisi
        ActiveCell.Offset(0, 1).Activate
        débutCC = DateAdd("d", 1, débutCC)                  'on ajoute un jour à chaque boucle
        ActiveCell.Value = Format(débutCC, "dd - mmm")      'on impose le même format de date aux valeurs concernées
'si c'est un week end  on cache les colonnes------------------------------------------------------------------
If ActiveCell.Offset(30, 0).Value = 6 Or ActiveCell.Offset(30, 0).Value = 7 Then
            ActiveCell.Offset(1, 0).Select
            Range(ActiveCell.Columns, ActiveCell.Offset(0, 1).Columns).EntireColumn.Hidden = True
            ActiveCell.Offset(-1, 0).Select
'si c'est un vendredi  on cache la colonne de l'après-midi-----------------------------------------------------
            ElseIf ActiveCell.Offset(30, 0).Value = 5 Then
            ActiveCell.Offset(1, 0).Select
            ActiveCell.Offset(0, 1).Columns.EntireColumn.Hidden = True
            ActiveCell.Offset(-1, 0).Select
            End If
Loop
End If

'les colonnes n'ayant pas de date seront cachées---------------------------------------------------------------
Range(ActiveCell.Offset(0, 1), Cells(6, 42)).Columns.EntireColumn.Hidden = True
Range("C:D").Columns.AutoFit
Application.ScreenUpdating = True

end sub

Merci d'avance pour votre aie

Bonjour Arno51,

Pouvez-vous joindre un fichier pour simplifier la recherche ?

En prenant votre code, et en le testant, cela à fonctionné sans problème, donc l'erreur doit venir d'autre chose...

Cordialement,

Voici le code dans un fichier excel.

bien entendu le fichier est plus grand normalement mais logiquement avec ce que j'ai laissé dessus il n'y a pas d'erreur de code.

Si jamais ce n'est pas suffisant je le mettrai au complet.

merci d'avance

17admin.xlsm (181.82 Ko)

Bonjour,

Désolé, je ne vais pas être d'une grande aide, le programme s’exécute correctement à mon niveau.

Je ne rencontre aucun problème...

Cordialement,

ok merci quand même, je cherche à modifier le code mais c'est un problème de date.

j'ai l'impression que le code suivant ne marche pas:

        ActiveCell.Value = Format(débutCC, "dd - mmm")     

car lorsque je passe la souris dessus après qu'elle se soit effectué la date est sous format : dd/mm/yyyy

j'ai essayé de changer pour que ça corresponde mais ça déconne aussi.

par exemple la date donnée par débutCC est sous la forme 14/09/2018

et finCC sous la forme "21/09/2018"

donc les guillemets m’embêtent fortement..

code date

Bon j'ai trouvé une solution palliative :

Do Until débutCC = finCC                           'on boucle tant que la date finCC n'est pas saisi
        ActiveCell.Offset(0, 1).Activate
        débutCC = DateAdd("d", 1, débutCC)                  'on ajoute un jour à chaque boucle
        débutCC = Format(débutCC, "dd - mmm")
        ActiveCell.Value = débutCC     'on impose le même format de date aux valeurs concernées

la cellule active sera toujours égale à débutCC donc c'est bon et afin que la date soit bien indiquée dans le tableur Excel j'ai décomposé son écriture. Ce n'est surement pas la solution la plus jolie mais elle a le mérite de fonctionner..

merci quand même de s'être penché sur mon problème.

Rechercher des sujets similaires à "creation planning"