Code VBA, déterminer des périodes selon conditions

[jorge1201]

Bonjour le forum,

J'ai encore besoin de vos lumières pour avancer dans mon projet.

J'aimerais pouvoir ajouter dans les cellules B5 de chaque nouvelle feuille créée à l'aide d'un bouton (copie feuille "Modele") les dates de début et fin d'une période en fonction des dates entrées manuellement dans la feuille "Menu".

Pour mieux comprendre ma demande, j'ai mis en pièce jointe un extrait de mon projet avec toutes les explications nécessaires (en fin, je le crois) et les différents résultats attendus.

En vous remerciant d'avance et dans l'attente de vos réponses, je vous souhaite un excellent dimanche.

Jorge

 

[ROGER2327]

Re : Code VBA, déterminer des périodes selon conditions

Bonjour jorge1201.

Essayez ceci :​

Sub AjoutFeuilles_1()
Dim WS As Worksheet
Dim Plage1 As Range, Plage2 As Range
Dim Cell As Range
Set Plage1 = Worksheets("Menu").Range("B6:B7")
Set Plage2 = Worksheets("Menu").Range("C6:C" & Range("C65535").End(xlUp).Row)
For Each Cell In Plage2
    If Cell.Value = "" Then GoTo TheNext
        For Each WS In Worksheets
            If WS.Name <> "Modele" Or WS.Name <> "Menu" Then
            If WS.Name = Cell.Text Then GoTo TheNext
        End If
        Next WS
    Sheets("Modele").Copy After:=Sheets(Sheets.Count)
        On Error GoTo ErrorHandler
        Sheets(Sheets.Count).Name = "PT_" & Cell.Text
        With Sheets("PT_" & Cell.Text)
            .Range("B4") = Cell.Text
            .Range("B5") = "Période travaillée du " & _
                Format(WorksheetFunction.Max(DateSerial(Cell.Value, 1, 1), Plage1(1)), "dd.mm.yyyy") & _
                " au " & _
                Format(WorksheetFunction.Min(DateSerial(Cell.Value, 12, 31), Plage1(2)), "dd.mm.yyyy")
        End With
TheNext:
Next Cell
Exit Sub
ErrorHandler:
MsgBox "Le Nom " & Cell.Text & " n'est pas un nom de feuille valide, le traitement à été interrompu", vbCritical
End Sub

Si on ne veut pas utiliser les fonctions Excel MIN et MAX, on remplacera​

            .Range("B5") = "Période travaillée du " & _
                Format(WorksheetFunction.Max(DateSerial(Cell.Value, 1, 1), Plage1(1)), "dd.mm.yyyy") & _
                " au " & _
                Format(WorksheetFunction.Min(DateSerial(Cell.Value, 12, 31), Plage1(2)), "dd.mm.yyyy")

par

            .Range("B5") = "Période travaillée du " & _
                Format((DateSerial(Cell.Value, 1, 1) + Plage1(1) + Abs(DateSerial(Cell.Value, 1, 1) - Plage1(1))) / 2, "dd.mm.yyyy") & _
                " au " & _
                Format((DateSerial(Cell.Value, 12, 31) + Plage1(2) - Abs(DateSerial(Cell.Value, 12, 31) - Plage1(2))) / 2, "dd.mm.yyyy")

Bonne journée.


ROGER2327
#6626

Lundi 16 Palotin 140 (Déploration de Saint Achras, éleveur de Polèdres - fête Suprême Quarte)
16 Floréal An CCXXI, 5,6889h - consoude
2013-W18-7T13:39:12Z

 

[jorge1201]

Re : Code VBA, déterminer des périodes selon conditions

Bonjour le forum, Roger,

Il fallait y penser!!! La création d'une deuxième plage et l'utilisation des fonctions Min et Max ... tout paraît si clair après avoir lu ta réponse! Ta solution fonctionne parfaitement. Elle est ingénieuse, simple et efficace. Quoi demander de plus?

Un grand Merci Roger.
Cordialement.