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
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
elle ne fonctionne pas ..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.
VB: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
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
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
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