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
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..
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.