XL 2019 Date

[le___destin]

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]

Bonjour,

Deux choses :
1. Si on fusionne des cellules, les valeurs de G3 et G14 sont effacées.
2. Ca ne fonctionne pas si il y as des formules en F12:F14. Il faut alors modifier la macro.

Private Sub Worksheet_Change(ByVal Target As Range)
'ActiveSheet.Unprotect "0000"
Dim cellule As Range
   If Not Intersect(Target, [F12:F14]) Is Nothing Then
    Application.EnableEvents = False
    If Application.CountIf([F12:F14], "- -") = 3 Then
      [G12:G14].MergeCells = True
      GoTo Fin
    End If
    If [G12:G14].MergeCells = True Then
      [G12:G14].MergeCells = False
    End If
    For Each cellule In Intersect(Target, [F12:F14])
      If cellule.Value = "- -" Then
        cellule.EntireRow.Hidden = True
      Else
        cellule.EntireRow.Hidden = False
      End If
    Next cellule
Fin:
    Application.EnableEvents = True
  End If
'ActiveSheet.Protect "0000"
End Sub

Daniel

 

[le___destin]

Bonjour,

Deux choses :
1. Si on fusionne des cellules, les valeurs de G3 et G14 sont effacées.
2. Ca ne fonctionne pas si il y as des formules en F12:F14. Il faut alors modifier la macro.

Private Sub Worksheet_Change(ByVal Target As Range)
'ActiveSheet.Unprotect "0000"
Dim cellule As Range
   If Not Intersect(Target, [F12:F14]) Is Nothing Then
    Application.EnableEvents = False
    If Application.CountIf([F12:F14], "- -") = 3 Then
      [G12:G14].MergeCells = True
      GoTo Fin
    End If
    If [G12:G14].MergeCells = True Then
      [G12:G14].MergeCells = False
    End If
    For Each cellule In Intersect(Target, [F12:F14])
      If cellule.Value = "- -" Then
        cellule.EntireRow.Hidden = True
      Else
        cellule.EntireRow.Hidden = False
      End If
    Next cellule
Fin:
    Application.EnableEvents = True
  End If
'ActiveSheet.Protect "0000"
End Sub

Daniel

elle ne fonctionne pas ..

 

[danielco]

C'est ce que je t'avais dit. Comme F12:F14 contient des formules, utilise :

Private Sub Worksheet_Calculate()
Dim cellule As Range
  Application.EnableEvents = False
  If Application.CountIf([F12:F14], "- -") = 3 Then
    Application.DisplayAlerts = False
    [G12:G14].MergeCells = True
    Application.DisplayAlerts = True
    GoTo Fin
  End If
  If [G12:G14].MergeCells = True Then
    [G12:G14].MergeCells = False
  End If
  For Each cellule In [F12:F14]
    If cellule.Value = "- -" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule
Fin:
  Application.EnableEvents = True
End Sub

Daniel

 

[le___destin]

Ouii ca marche bien merciiiiiii
Un petite chose .peut on récupéré les continue du cellule si apres la fusion le svaleur de cellule test devien non nul .. revien 3 ligne avech le nom ....

 

[danielco]

Non, malheureusement, si l'on fusionne le cellules G12:G14, le contenu de G13 et G14 est perdu. Il faudrait les sauvegarder ailleurs. Tu es d'accord ?

Daniel

 

[le___destin]

merciiii bien

 

[le___destin]

on peut pas au moin annler la fusion

 

[danielco]

Non. Contrairement à ce qu'on fait manuellement, ce qui est fait par macro ne peut pas être annulé.

Daniel

 

[le___destin]

merciii

 

[le___destin]

peut on au moin apres le fusion suprimer la liste

 

[danielco]

Tu veux dire effacer G12:G14 ?

Daniel

 

[le___destin]

bonjour Daniel
oui

 

[danielco]

Bonjour,

Essaie :

Private Sub Worksheet_Calculate()
Dim cellule As Range
  Application.EnableEvents = False
  If Application.CountIf([F12:F14], "- -") = 3 Then
    Application.DisplayAlerts = False
    [G12:G14] = ""
    [G12:G14].MergeCells = True
    Application.DisplayAlerts = True
    GoTo Fin
  End If
  If [G12:G14].MergeCells = True Then
    [G12:G14].MergeCells = False
  End If
  For Each cellule In [F12:F14]
    If cellule.Value = "- -" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule
Fin:
  Application.EnableEvents = True
End Sub

 

[le___destin]

ca marche mais la validation de donne reste ' liste' reste

 

[danielco]

Oui, mais tu n'avais pas demandé de la supprimer non plus.

Private Sub Worksheet_Calculate()
Dim cellule As Range
  Application.EnableEvents = False
  If Application.CountIf([F12:F14], "- -") = 3 Then
    Application.DisplayAlerts = False
    [G12:G14] = ""
    [G12:G14].Validation.Delete
    [G12:G14].MergeCells = True
    Application.DisplayAlerts = True
    GoTo Fin
  End If
  If [G12:G14].MergeCells = True Then
    [G12:G14].MergeCells = False
  End If
  For Each cellule In [F12:F14]
    If cellule.Value = "- -" Then
      cellule.EntireRow.Hidden = True
    Else
      cellule.EntireRow.Hidden = False
    End If
  Next cellule
Fin:
  Application.EnableEvents = True
End Sub