Re : Aide pour macro
Bonjour,
Je reviens vers vous pour une modification importante sur l'onglet Roulement de mon planning
Comme je l'expliquai plus haut, chaque bouton vert "Roulement" commande l'ouverture d'un calendrier sur lequel on indique la date "lundi obligatoire" à partir de laquelle on lance le roulement.
Ce dernier se termine systématiquement sur le dernier jour de décembre.
Je souhaiterais pouvoir définir une date de fin qui serait par défaut sur la date du 31.12
L'Userform et la macro sont à modifier mais je ne s'est pas par quel bout le prendre.
L'userform s'appelle Ufchoixdate
Le macro est la suivante :
Sub CopieRoulement(Ligne)
Jrladate = Weekday(TxbChoixDate.Value)
If Jrladate <> 2 Then
MsgBox ("La date Choisie n'est pas un lundi, recommencez !")
UfChoixDate.TxbChoixDate.SetFocus
UfChoixDate.TxbChoixDate.SelStart = 0
UfChoixDate.TxbChoixDate.SelLength = Len(TxbChoixDate)
GoTo fin
End If
Mladate = Month(TxbChoixDate.Value) 'N° du mois
Dladate = Day(TxbChoixDate.Value) 'N° du jour
Jladate = Dladate + 3 'Le jour sur la feuille du mois
indexfeuille = Mladate + 4
CellColRoul = 4
Numladate = Sheets(indexfeuille).Cells(3, Jladate)
Finladate = Decembre.Range("AH3")
NbrJours = Finladate - Numladate + 1
For I = 1 To NbrJours
Sheets(indexfeuille).Cells(Ligne, Jladate) = Roulements.Cells(Ligne, CellColRoul)
'Sheets(indexfeuille).Cells(Ligne, Jladate).Select
Sheets(indexfeuille).Select
Cells(Ligne, Jladate).Select
'Sheets(indexfeuille).Cells(Ligne, Jladate).Interior.ColorIndex = Cells(Ligne, CellColRoul).Interior.ColorIndex
If Mladate = 1 Then 'Janvier
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 2 Then 'Février
If Day(Worksheets("Février").Range("AF3")) = 29 Then 'Vérifie si février à 29 jours
If Jladate = 32 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
Else
If Jladate = 31 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
End If
ElseIf Mladate = 3 Then 'Mars
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 4 Then 'Avril
If Jladate = 33 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 5 Then 'Mai
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 6 Then 'Juin
If Jladate = 33 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 7 Then 'Juillet
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 8 Then 'Aout
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 9 Then 'Septembre
If Jladate = 33 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 10 Then 'Octobre
If Jladate = 34 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
ElseIf Mladate = 11 Then 'Novembre
If Jladate = 33 Then
indexfeuille = indexfeuille + 1
Jladate = 3
Mladate = Mladate + 1
End If
End If
If CellColRoul = 31 Then
CellColRoul = 3
End If
Jladate = Jladate + 1
CellColRoul = CellColRoul + 1
Next I
UfChoixDate.Hide
fin:
End Sub
Je vous transmets le dernier fichier pour m'aider à faire les modifs
Merci par avance
Dirmon
Cijoint.fr - Service gratuit de dépôt de fichiers
,
