'je commente je commente :)
'a la fermeture du classeur on clear la derniere qui a été cliquée
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.Unprotect Password:="" 'je leve la protection
Application.EnableEvents = False ' j'inhibe les evenements
Application.ScreenUpdating = False 'j'inhibe le raffraichissement de l'ecran
If ActiveSheet.CustomProperties.Count > 0 Then 'si il n'y a une custom properties
With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With ' on clearformats le range (la valeur de la custompropertie)
ActiveSheet.CustomProperties(1).Delete ' je supprime la custom propertie
End If
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True ' on re protege
ActiveSheet.EnableSelection = xlNoRestrictions ' toute restriction bye bye!!!
Application.EnableEvents = True 'on déinhibe les evenement
Application.ScreenUpdating = True ' on réactive le rafraichissement de l'ecran
End Sub
'au click sur cellule maintenant
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name = "Feuil1" Then ' on veux que ca fonctionne que sur feuil1
' Depart
ActiveSheet.Unprotect Password:="" 'je leve la protection
Application.ScreenUpdating = False 'j'inhibe le raffraichissement de l'ecran
If ActiveSheet.CustomProperties.Count = 0 Then 'si il n'y a une custom properties
ActiveSheet.CustomProperties.Add Name:="oldaddress", Value:=Target.Address(0, 0) ' on memorise la target active(activecell)
Cells(3, 2).Resize(, 24).Copy 'on copy la ligne 3
With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With 'on paste le format
Else ' sil y a bien une custom !!!
With Range(ActiveSheet.CustomProperties(1).Value): .ClearFormats: .RowHeight = 15: End With ' on clearformats le range (la valeur de la custompropertie)
ActiveSheet.CustomProperties(1).Value = Target.Address(0, 0) ' on change l'adress dans la customproperties
Cells(3, 2).Resize(, 24).Copy 'on copy la ligne 3
With Cells(Target.Row, 2).Resize(, 24): .RowHeight = 40: .PasteSpecial Paste:=xlPasteFormats: End With 'on paste le format
End If
Application.CutCopyMode = False ' on arrete le copypaste
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True 'on reprotege
ActiveSheet.EnableSelection = xlNoRestrictions ' toute restriction bye bye!!!
Application.ScreenUpdating = True ' on réactive le rafraichissement de l'ecran
End If
End Sub