Afficher la date dans une cellule

If Target.Column = 5 and target.row=34 Then Target.Value = Now

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Option Explicit
'*** CLIC DROIT CHANGE LA COULEUR DES CELLULES DU TABLEAU EN VERT OU EN GRIS PLAGE E2:P15
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("E2:P15")) Is Nothing Then
     Cancel = True                                                'Pour garder le focus sur la cellule activ?e

      With Target.Interior
          .ColorIndex = IIf(.ColorIndex = 16, 4, 16)              'Couleur gris(16), vert clair(4)fond cellule
      End With
           Cells(R, 17).Interior.ColorIndex = 15                  'Place ligne REPERE en gris colonne (R)
  End If
    Calculate                                                     'Pour compter les totaux des cellules mise en gris
End Sub

'*** RECOPIE LA VALEUR DE LA PLAGE LIGNE(E20:P20) MOIS PAR MOIS COLONNE 17(Q) PLAGE Q2:Q26
Public Sub Worksheet_Calculate()
    Application.EnableEvents = False
    C = Month(Now) + 4
    R = [Z1].Value: If R < 2 Then R = 1
    Cells(R, 17).Font.ColorIndex = 10       'Vert fonc?
    Cells(R, 17).Interior.ColorIndex = 15

    With Cells(R, 17).Interior
                     .ColorIndex = 15       'Gris affiche barre rep?re Gris clair
        If Cells(20, C).Text <> Cells(R, 17).Text Then
               R = R + 1: If R > 26 Then R = 2
               [Z1].Value = R
               Cells(R, 17).Value = Cells(20, C).Value
              .ColorIndex = xlNone
        End If
    End With
         Cells(R, 17).Font.ColorIndex = 5    'Bleu
         
'*** Test si "RETARD" o? "SOLDE"
Select Case Range("O35").Value
    Case Is < 0
        With Range("P35")
            .Value = "RETARD"
            .Font.ColorIndex = 3    'Rouge
        End With
    Case Is > 0
        With Range("P35")
            .Value = "SOLDE"
            .Font.ColorIndex = 4    'Vert
        End With
    Case Is = 0
        With Range("P35")
            .Value = ""
            .Font.ColorIndex = xlNone
        End With
End Select
       Application.EnableEvents = True
End Sub

'*** BOUTON POUR EFFACER LA COLONNE(Q)
Public Sub EffaceCellule()
  With Ws
       If MsgBox("Effacer les donn?es de la colonne Q ", vbYesNo, "Demande de confirmation") = vbYes Then
           [Q2:Q26].ClearContents
           [Q2:Q26].Interior.ColorIndex = xlNone
                    Cells(R, 17).Interior.ColorIndex = 15   'Remets ligne REPERE en gris
        Else
         Exit Sub                                                       'Si r?ponse = Non on sort
      End If
  End With
End Sub

'#######################

'*** Pour effacer par double clic les donn?es colonne F31:F34
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
         If Not Intersect(Range("F31:F34"), Target) Is Nothing Then
                  Cancel = True
                  Target.Value = ""
         End If
End Sub

'*** Test et entr?e des donn?es
Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("$F$31:$F$34")) Is Nothing Then Exit Sub
Application.EnableEvents = False           '*** D?sactive les autres ?v?nements que pourrait d?clencher la macro

Select Case Target.Value
          Case IsNumeric(Target.Value) And Target.Value = 0 And Not IsEmpty(Target.Value) = False       '*** Si Z?ro entrer
                   Target.Value = ""
                   Target.Select

          Case Is < 0                                 '*** Si chiffre n?gatif
                   Target.Value = ""
                   Target.Select

'*****************************
          Case Is <> ""                               '*** Si cellule n'ai pas vide
                  With Target.Offset(0, 1)
                         .Value = "Versement en attente"
                         .Font.ColorIndex = 3                        '*** Rouge
                         Target.Value = .Offset(0, -1)
           End With

          Case Is = ""                                                    '*** Si cellule vide
                   With Target.Offset(0, 1)
                          .Value = "Versement effectuer"
                          .Font.ColorIndex = 4                        '*** Vert
                          Target.Value = .Offset(0, -1)
          End With

          Case Else: Range("F31:F34").Value = ""
                           Range("G31:G34").Value = ""
End Select
Application.EnableEvents = True              '*** R?active les ?v?nements

If Application.WorksheetFunction.CountA(Range("F31:F34")) = 0 Then Range("G31:G34").ClearContents
End Sub

'*** Permets de descendre d'une ligne Offset(1,-1)   1 pour descendre d'une ligne et -1 pour avance colonne
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         If Not Intersect(Target, Range("G31:G34")) Is Nothing Then Target.Offset(1, -1).Select
End Sub

'*** Date sur clic droit en REM provisoirement
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
'If Target.Column = 5 And Target.Row = 34 Then
'   Target.Value = Format(Date, "dd mmm yyyy")
'   Cancel = True
'End If
'End Sub