le___destin
XLDnaute Occasionnel
Je veux créer une colone d'un tableau lorsque je rempli la premiere case emplie automatiquement les autre cellule jusqu'à la date du fin du moi
@job75 je connaissais pas cette methode de resize avec target (intéressant)Bonjour le fil, le forum,
En VBA je préfère nettement ceci, sans boucle :
Bonne journée.VB:Private Sub Worksheet_Change(ByVal Target As Range) If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target) .NumberFormat = Target.NumberFormat .DataSeries .Offset(.Count).Resize(Rows.Count - .Count - .Row + 1).Delete xlUp 'RAZ dessous End With Application.EnableEvents = True End Sub
Sub test2()
Set Target = [A1]
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Target.Resize(Day(DateSerial(Year(Target), Month(Target) + 1, 0)) - Day(Target) + 1, 1)
.NumberFormat = Target.NumberFormat
.DataSeries
.Offset(.Count).Resize(Rows.Count - .Count - .Row + 1).ClearContents
End With
Application.EnableEvents = True
End Sub
Sub test2()
Set Target = [A1]
If IsDate(Target(1)) And Target.Count = 1 Then
Application.EnableEvents = False
With Target.Resize(Day(DateSerial(Year(Target), Month(Target) + 1, 0)) - Day(Target) + 1, 1)
.NumberFormat = Target.NumberFormat
.DataSeries
Range(Target.Offset(30, 0), .Cells(.Count + 1)).ClearContents
End With
Application.EnableEvents = True
End If
End Sub
Sub test2()
Set Target = [A1]
If IsDate(Target(1)) And Target.Count = 1 Then
Application.EnableEvents = False
With Target.Resize(Day(DateSerial(Year(Target), Month(Target) + 1, 0)) - Day(Target) + 1, 1)
.Cells(2).Resize(30).ClearContents
.NumberFormat = Target.NumberFormat
.DataSeries
End With
Application.EnableEvents = True
End If
End Sub
merciiiii bienBonjour,
Essaie le code de job75 modifié :
VB:Private Sub Worksheet_Change(ByVal Target As Range) If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub If Target.Address <> "$K$11" Then Exit Sub If Day(Target) <> 1 Then Exit Sub Application.EnableEvents = False [K12:K41] = "" Rows("12:41").Hidden = False With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target) .NumberFormat = Target.NumberFormat .DataSeries End With With Application If .CountA([K39:K41]) < 3 Then Rows(41).Offset(-2 + .CountA([K39:K41])).Resize(3 - .CountA([K39:K41])).Hidden = True End If End With Application.EnableEvents = True End Sub
Dans le classeur joint, j'ai ajouté des mises en forme pour colorer en bleu les samedis et dimanche. Les modifs sont seulement sur la feuille tab. Je peux les reporter sur les autres.
Daniel
mercie bienJe vais effacer les plages C11:C41 et I11:I41 et modifier les trois feuilles.
Je retournerai le classeur dès que ce sera fait.
Daniel
y'a t'il solution aussi que si je saisi un valeur dans les cellule des colonnes J et I prend zéro si le jour samedi ou dimanche
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim C As Range
If Left(Sh.Name, 3) <> "tab" Then Exit Sub
If Target.Address = "$K$11" Then
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
If Day(Target) <> 1 Then Exit Sub
Application.EnableEvents = False
[C11:C41,I11:I41].Value = 0
[K12:K41] = ""
Rows("12:41").Hidden = False
With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target)
.NumberFormat = Target.NumberFormat
.DataSeries
End With
With Application
If .CountA([K39:K41]) < 3 Then
Rows(41).Offset(-2 + .CountA([K39:K41])).Resize(3 - .CountA([K39:K41])).Hidden = True
End If
End With
Application.EnableEvents = True
ElseIf Not Intersect(Target, [C11:C41,I11:I41]) Is Nothing Then
Application.EnableEvents = False
For Each C In Intersect(Target, [C11:C41,I11:I41])
If Application.Weekday(Cells(C.Row, 11), 2) > 5 Then
C.Value = 0
End If
Next C
Application.EnableEvents = True
End If
End Sub
merci bienJ'ai supprimé ls macros situées dans les feuilles et je les ai remplacées par celle-ci, dans le module "ThisWorkbook". Elle ne s'applique qu'aux feuilles dont le nom commence par "tab" :
VB:Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim C As Range If Left(Sh.Name, 3) <> "tab" Then Exit Sub If Target.Address = "$K$11" Then If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub If Day(Target) <> 1 Then Exit Sub Application.EnableEvents = False [C11:C41,I11:I41].Value = 0 [K12:K41] = "" Rows("12:41").Hidden = False With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target) .NumberFormat = Target.NumberFormat .DataSeries End With With Application If .CountA([K39:K41]) < 3 Then Rows(41).Offset(-2 + .CountA([K39:K41])).Resize(3 - .CountA([K39:K41])).Hidden = True End If End With Application.EnableEvents = True ElseIf Not Intersect(Target, [C11:C41,I11:I41]) Is Nothing Then Application.EnableEvents = False For Each C In Intersect(Target, [C11:C41,I11:I41]) If Application.Weekday(Cells(C.Row, 11), 2) > 5 Then C.Value = 0 End If Next C Application.EnableEvents = True End If End Sub
Regarde le classeur joint. Teste-le.
Daniel
Sub Masque_lig()
Dim cellule As Range
For Each cellule In Range("F12:F14")
If Range("B12") > "0" And cellule.Value = "- -" Then
cellule.EntireRow.Hidden = True
Else
cellule.EntireRow.Hidden = False
End If
Next cellule
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cellule As Range
If Not Intersect(Target, [F12:F14]) Is Nothing Then
Application.EnableEvents = False
For Each cellule In Intersect(Target, [F12:F14])
If Range("B12") > "0" And cellule.Value = "- -" Then
cellule.EntireRow.Hidden = True
Else
cellule.EntireRow.Hidden = False
End If
Next cellule
Application.EnableEvents = True
End If
End Sub