Re : A L'AIDE!!!!!!!!Feuilles protégées
Désolé mais le fichier à une taille de 195 ko et compresser je n'arrive pas en dessous de 48 ko je cherche un moyen de compression plus important.
Voici le code d'une page je ne sais as si cela vous aideras
Private Sub Worksheet_Activate()
Affecte
ActiveSheet.CircleInvalid
On Error Resume Next
'On desactive la suppression
'Application.CommandBars("Clear").FindControl(ID:=1964).Enabled = False
'
TCDCA.PivotTables("TCD_Client_Mois").PivotCache.Refresh
End Sub
Private Sub Worksheet_Deactivate()
'On active la suppression
'Application.CommandBars("Clear").FindControl(, 1964).Enabled = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Exit Sub
If Target.Column > 17 Then
If IsEmpty(Cells(Target.Row, 1)) = True Then
Cells(Target.Row, 1).Activate
Else
Cells(Target.Row + 1, 1).Activate
End If
Exit Sub
End If
If ActiveCell.Locked = True Then Cells(ActiveCell.Row + 1, 1).End(xlUp).Select
'On tri le tableau si une ligne est effacée
If Application.CountA(Rows(Target.Row)) = 0 And Cells(Target.Row, 1).Locked = False _
And Not IsEmpty(Cells(Target.Row + 1, 1)) Then
Application.EnableEvents = False
Columns("A:Q").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers
Application.EnableEvents = True
Exit Sub
End If
If Cells(Target.Row + 1, 1).Locked = False Then GoTo fini:
If IsEmpty(Cells(Target.Row, 1)) = True Then GoTo fini:
Application.EnableEvents = False
Application.ScreenUpdating = False
'Deblocage et mise en place de la ligne suivante
Set c = ActiveCell
Range(Cells(Target.Row, 1).Address, Cells(Target.Row, 17).Address).Copy
Range(Cells(Target.Row + 1, 1).Address, Cells(Target.Row + 1, 17).Address).PasteSpecial Paste:=xlPasteValidation
Range(Cells(Target.Row + 1, 1).Address, Cells(Target.Row + 1, 17).Address).Locked = False
Cells(Target.Row + 1, 14).FormulaR1C1 = _
"=GETPIVOTDATA(""Montant HT"",Feuil2!R3C1,""Nom"",RC[-13])"
c.Select
Application.EnableEvents = True
Application.ScreenUpdating = True
fini:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub