Autres [RESOLU] Dans quelle macro ThisWorkbook dois-je intervenir

[un internaute]

Bonjour le forum
Je vais tenter d'expliquer le mieux possible!!!
Je voudrais faire dans domaine A6:C36 comme dans domaine D6: H36 (pour faire afficher colonne H double click cellule G1)
Je suis bloqué par la date du jour colonne B. Exemple si je clique sur cellule B10 ça met pas le bon jour.
Je ne sais pas si j'ai été clair!!!
Toutes mes excuses si c'est pas le cas
Cordialement

 

[Phil69970]

Bonjour @un internaute

De ce que j'ai compris mais pas certain du tout donc un peu beaucoup au pif !!!

Merci de ton retour

 

[un internaute]

Bonjour Phil69970
Presque ça.
Lorsque je clique sur une cellule B15 par exemple je tape 10 dans cellule B15 puis flèche droite pour aller chercher Prélèvement URSSAF Septembre 2024 ça doit apparaître en couleur cellule A 15 en gris (couleur15) en B15 couleur jaune (36) et C15 couleur verte (4)
Il faut laisser actif

Beep
MsgBox "PAS LE BON JOUR"
Target = ""

Merci à toi

 

[un internaute]

Bonjour le forum
Voilà
Merci à vous pour les retours
Cordialement

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim NombreJour As Integer
Dim LaDate As Date
Dim MoisSuivant As String

  If Target.Count > 1 Then Exit Sub
 
  Application.ScreenUpdating = False
  ' On recherche si la page est surveillée
   If Target.Column = 2 And Target.Row > 4 And Target = "" Then
    Range(Cells(Target.Row, "A"), Cells(Target.Row, "C")).ClearContents
    If Range("D" & Target.Row) = "" Then Range("H" & Target.Row).ClearContents
    GoTo ExitSub
  End If
  If Not Intersect(Sh.Range("J1"), Target) Is Nothing Then              'Modif le 18/11/2023 Données = Validation
  ElseIf InStr(1, "JanvierFévrierMarsAvrilMaiJuinJuilletAoûtSeptembreOctobreNovembreDécembre", _
              Split(Sh.Name, " ")(0), vbTextCompare) Then
    Application.EnableEvents = False
    ' Calcul du nombre de jour dans le mois indiqué par le nom de la feuille
    NombreJour = Day(DateAdd("m", 1, DateValue(Sh.Name)) - 1)
    
      ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée
       LaDate = DateSerial(Split(Sh.Name, " ")(1), Month(DateValue(Sh.Name)), Target.Row - 5)
''''''''    If Target.Row - 5 > Day(Date) And Target.Column < 4 Then
''''''''      Beep
''''''''      MsgBox "PAS LE BON JOUR"
''''''''      Target = ""
'''''''    'Else

      If Target.Column = 5 Then     ' Colonne E
        If Target <> "" Then
          If Target.Row > 4 Then
            Range("D" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
          End If
            Range("H" & Target.Row) = LaDate
          Else
            Range("D" & Target.Row).Resize(, 4).ClearContents
            If Range("A" & Target.Row) = "" Then
              Range("H" & Target.Row) = ""
            End If
        End If
''''      'End If
      
      ' Surveille la plage du 1er au dernier jours du mois
      If Not Intersect(Sh.Range("B6:C" & 5 + NombreJour), Target) Is Nothing Then
        ' Reconstruit la date de fonction du nom de la feuille et du numéro de ligne sélectionnée

        ' Si la colonne B et la colonne C est vide on efface la date
        Range("A" & Target.Row) = IIf(Range("B" & Target.Row) & Range("C" & Target.Row) = "", "", Application.Proper(Format(LaDate, "dddd dd mmmm yyyy")))
        If Range("A" & Target.Row) <> "" Then
          Range("H" & Target.Row) = LaDate
        Else
          If Range("D" & Target.Row) = "" Then
            Range("H" & Target.Row) = ""
          End If
        End If

        ' si la ligne modifiée est la dernière du mois et que la colonne est la C
        If Target.Row = NombreJour + 5 And Target.Column = 3 Then
          ' On construit le nom de la feuille du mois suivant
          MoisSuivant = MonthName(Month(DateAdd("m", 1, DateValue(Sh.Name)))) & " " & Year(DateAdd("m", 1, DateValue(Sh.Name)))
          ' On va vérifier si la feuille existe
          If FeuilleExiste(MoisSuivant) = False Then GoTo ExitSub
          ' La feuille existe
          With Sheets(MoisSuivant)
            'On la rend visible
            .Visible = xlSheetVisible
            ' On masque celle que l'on vient de finir
            ActiveSheet.Visible = xlSheetHidden
            ' et on la sélectionne
            .Select
          End With
        End If
      End If
    End If
    End If
ExitSub:
  Application.EnableEvents = True
  Application.ScreenUpdating = True
'  Application.Calculation = xlAutomatic
End Sub

Ajout ligne

Range("H" & Target.Row) = LaDate          ' modifié le 06/10/24 ajout ligne