Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Date

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
 

danielco

XLDnaute Accro
Essaie :

VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim C As Range
  If Left(Sh.Name, 4) <> "mois" Then Exit Sub
  ActiveSheet.Unprotect "0000"
  Application.EnableEvents = False
  If Target.Address = "$D$11" Then
    If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
    If Day(Target) <> 1 Then Exit Sub
    [L11:L41,F11:F41].Value = 0
    [D12:D41] = ""
    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([D39:D41]) < 3 Then
        Rows(41).Offset(-2 + .CountA([D39:D41])).Resize(3 - .CountA([D39:D41])).Hidden = True
      End If
    End With
    Application.EnableEvents = True
  ElseIf Not Intersect(Target, [L11:L41,F11:F41]) Is Nothing Then
    Application.EnableEvents = False
    For Each C In Intersect(Target, [L11:L41,F11:F41])
      If Application.Weekday(Cells(C.Row, 4), 2) > 5 Then
        C.Value = 0
      End If
    Next C
  End If
  If Not Intersect(Target, [L11:L41]) Is Nothing Then
    If Target.Value <> 0 And Target.Offset(, 6) = 0 Then
      Target.Value = 0
    End If
  End If
  ActiveSheet.Protect "0000"
  Application.EnableEvents = True
End Sub

Daniel
 

le___destin

XLDnaute Occasionnel
bonsoirs je veux dire qu'on doit pas avoir un valeur sup à zéro dans la colonne L si la cellule F de même ligne = 0
je veux avoirs une résultat comme indique en vert par exemple si F14 =0 alors L14=0 si nn L14= valeur saisir par clavier
dans le dernière code toujours colonne L =0
 

danielco

XLDnaute Accro
Essaie :

VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim C As Range
  If Left(Sh.Name, 4) <> "mois" Then Exit Sub
  ActiveSheet.Unprotect "0000"
  Application.EnableEvents = False
  If Target.Address = "$D$11" Then
    If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
    If Day(Target) <> 1 Then Exit Sub
    [L11:L41,F11:F41].Value = 0
    [D12:D41] = ""
    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([D39:D41]) < 3 Then
        Rows(41).Offset(-2 + .CountA([D39:D41])).Resize(3 - .CountA([D39:D41])).Hidden = True
      End If
    End With
    Application.EnableEvents = True
  ElseIf Not Intersect(Target, [L11:L41,F11:F41]) Is Nothing Then
    Application.EnableEvents = False
    For Each C In Intersect(Target, [L11:L41,F11:F41])
      If Application.Weekday(Cells(C.Row, 4), 2) > 5 Then
        C.Value = 0
      End If
    Next C
  End If
  If Not Intersect(Target, [L11:L41]) Is Nothing Then
    If Target.Value <> 0 And Target.Offset(, 6) = 0 Then
      Target.Value = 0
    End If
  End If
  ActiveSheet.Protect "0000"
  Application.EnableEvents = True
End Sub

Daniel
 

danielco

XLDnaute Accro
Oui, désolé :

VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim C As Range
  If Left(Sh.Name, 4) <> "mois" Then Exit Sub
  ActiveSheet.Unprotect "0000"
  Application.EnableEvents = False
  If Target.Address = "$D$11" Then
    If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
    If Day(Target) <> 1 Then Exit Sub
    [L11:L41,F11:F41].Value = 0
    [D12:D41] = ""
    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([D39:D41]) < 3 Then
        Rows(41).Offset(-2 + .CountA([D39:D41])).Resize(3 - .CountA([D39:D41])).Hidden = True
      End If
    End With
    Application.EnableEvents = True
  ElseIf Not Intersect(Target, [L11:L41,F11:F41]) Is Nothing Then
    Application.EnableEvents = False
    For Each C In Intersect(Target, [L11:L41,F11:F41])
      If Application.Weekday(Cells(C.Row, 4), 2) > 5 Then
        C.Value = 0
      End If
    Next C
  End If
  If Not Intersect(Target, [L11:L41]) Is Nothing Then
    If Target.Value <> 0 And Target.Offset(, -6) = 0 Then
      Target.Value = 0
    End If
  End If
  ActiveSheet.Protect "0000"
  Application.EnableEvents = True
End Sub

Daniel
 

Discussions similaires

Réponses
7
Affichages
330
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…