Autres Enregistrer sur Onglet TOTO

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

  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("A3:A" & Rows.Count)) Is Nothing Then
    Application.EnableEvents = False
    If Not IsDate(Target) Then
      Target.Resize(, 4).ClearContents
    Else
      Range("B" & Target.Row) = Sh.Name
      Range("C" & Target.Row) = "Oui"
    End If
    Range("D" & Target.Row) = IIf(Target = "", "", CDate(Cells(Target.Row, 1)))
    Target = IIf(Target = "", "", Application.Proper(Format(CDate(Cells(Target.Row, 4)), "dddd dd mmmm yyyy")))     ' En cas de suppression manuelle de la colonne A
  End If
Range("A1").Select
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Indice As Integer, NbColonne As Integer
Dim Tb, TbCoul, X, TbFont, Label As String
Dim Cel As Range
Dim Ligne As Integer

  Application.Calculation = xlCalculationAutomatic
 
  Select Case UCase(Sh.Name)             ' Cette ligne permet de modifier l'onglet. Exemple "Matelas Tournés" sans modifier la macro "MATELAS TOURNÉS"
    Case "TOTO"
      NbColonne = 3
    
      If Target.Column = NbColonne + 1 And Target.Row >= 3 And Range("A" & Target.Row) <> "" Then
        Application.EnableEvents = False
        TbFont = Array(5, 1)                'Ces 3 Lignes en commentaire pour afficher Non
        TbCoul = Array(35, 40)
        Tb = Array("", "Oui")
        Cancel = True
        X = UCase(Trim(Target))
        If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
          Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
          Label = Tb(Indice)
          With Target
            .Value = Label
            .Interior.ColorIndex = TbCoul(Indice)
            .Font.ColorIndex = TbFont(Indice)
          End With
          With ActiveCell.Offset(0, -NbColonne).Resize(1, NbColonne)
            If Label = "Oui" Then
              Target.Offset(, 1) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
              Target.Offset(, -3).Resize(, 3).Font.Strikethrough = True
            Else                           'Else seul pour effacer la date au Double Click
            
    '        ElseIf Label = "Non" Then       'ElseIf Label = "Non" Then => pour ne pas effacer la date au Double Click
            
              Target.Offset(, -3).Resize(, 3).Font.Strikethrough = False
              Target.Offset(, 1).ClearContents
              
            End If
          End With
        End If
      End If
    Application.EnableEvents = True
   Case Else
  
      If Not Intersect(Target, Range("C4:C" & Range("A" & Rows.Count).End(xlUp).Row + 1)) Is Nothing Then
        Application.ScreenUpdating = False
        Ligne = Range("A" & Rows.Count).End(xlUp).Row
        If (Target.Row = Ligne And Range("A" & Ligne) <> "") Or (Target.Row = Ligne + 1 And Range("A" & Ligne + 1) = "") Then
          Application.EnableEvents = False
          TbFont = Array(5, 1)               'Ces 3 Lignes en commentaire pour ne pas afficher Non
          TbCoul = Array(35, 40)
          Tb = Array("", "Oui")
          Cancel = True
    
          X = UCase(Trim(Target))
          If UBound(Filter(Tb, X, compare:=vbTextCompare)) >= 0 Then
            Indice = Application.Match(X, Tb, 0) Mod (1 + UBound(Tb))
            Label = Tb(Indice)
            Set Cel = Target
    
            If Label = "Oui" Then
              If Target.Row = 21 Then                       ' On clicque sur la ligne 21 pour un nouvea cycle
                Range("A3:D20").ClearContents
                Range("C3:C20").Interior.ColorIndex = 35
                Set Cel = Range("C3")
              End If
              Cel.Offset(, -2).Resize(, 2).Font.Strikethrough = True
              Cel.Offset(, 1).Value = Date
              Cel.Offset(, -2) = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
              Cel.Offset(, -1).Value = Sh.Name
            Else
              Cel.Offset(0, -2).Resize(1, 2).Font.Strikethrough = False
              Cel.Offset(, -2).Resize(, 4).ClearContents
              Cel.Offset(, 1).Interior.ColorIndex = 36
              Cel.Offset(, 2).Interior.ColorIndex = 8
              Cel.Offset(, -2).Interior.ColorIndex = 36
              Cel.Offset(, -1).Interior.ColorIndex = 35
            End If
          End If
          
          With Cel
            .Value = Label
            .Interior.ColorIndex = TbCoul(Indice)
            .Font.ColorIndex = TbFont(Indice)
          End With
          Application.EnableEvents = True
        End If
        End If
       End Select
      If Target.Address = "$F$1" Then
        Cancel = True
        UsfChoix.Show 0
      End If
  
  Range("A1").Select
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error Resume Next
Application.ScreenUpdating = False
For I = 1 To Sheets.Count
If Sheets(I).Name <> "TOTO" Then Sheets(I).Visible = False
Next I
End Sub

Option Explicit

Private Sub ComboBox1_Change()
Dim I As Integer

  If Me.ComboBox1.ListIndex = -1 Then Exit Sub
  Application.ScreenUpdating = False
  With Sheets(Me.ComboBox1.Value)
    .Visible = xlSheetVisible
'    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
  End With
  For I = 1 To Sheets.Count
    If Sheets(I).Name <> Me.ComboBox1 Then Sheets(I).Visible = xlSheetVeryHidden
  Next I
  Unload Me
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub UserForm_Initialize()
Dim I As Integer

  With Me.ComboBox1
    .Font.Size = 12
    For I = 1 To Sheets.Count
      .AddItem Sheets(I).Name
    Next I
  End With
End Sub