Bonjour le forum
Je voudrais incorporer la macro qui est en commentaires dans celle ci-dessous
Lorsque je clique sur une cellule quelconque de la colonne B avec la souris jusqu'à trouver la bonne date qui s'affiche colonne A puis je tape un montant colonne B mais lorsque je fait enter ça m'affiche la date suivante colonne A et je doit faire Suppr pour la supprimer
Je pige pas
Merci à vous

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Obj As Shape, Ligne As Long
 
  ' Change automatiquement le texte du bouton
 
  Ligne = Selection.Row
  If Range("B" & Ligne) = "" Or Ligne > Range("A" & Rows.Count).End(xlUp).Row Or Ligne < 5 Then
    Ligne = Range("A" & Rows.Count).End(xlUp).Row
  End If
 
    If UCase(Sh.Name) <> "MENU" And Target.Count = 1 And Target.Column = 2 And Target.Row > 5 Then
      Application.ScreenUpdating = False
'      ActiveSheet.Unprotect
 
      For Each Obj In ActiveSheet.Shapes
        If InStr(1, Obj.TextFrame.Characters.Text, "Centrer Texte", vbTextCompare) > 0 Then Exit For
      Next Obj
 
      If Not Obj Is Nothing Then
      ' Calcul de la dernière ligne.Celle-ci sera automatiquement centrée sur les colonnes B & C en cliquant sur le Bouton Centrer Texte Sur Plusieurs Colonnes
 
        With Obj.TextFrame
          If Range("B" & Ligne).HorizontalAlignment = xlCenterAcrossSelection Then
            .Characters.Text = "Annuler Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
            .Characters(Start:=23, Length:=22).Font.ColorIndex = 5
          Else
            .Characters.Text = "Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
            .Characters(Start:=15, Length:=22).Font.ColorIndex = 5
 
          End If
        End With
      End If
'      ActiveSheet.Protect
    End If
End Sub
Incorporer la macro ci-dessous qui est en commentaires dans celle ci-dessus


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Dim LaDate As Date, J As Long
'  If Target.Address <> Selection.Address Then Exit Sub
'    If Target.Column = 2 Then
'        Application.ScreenUpdating = False
'        For J = 6 To 36
'            If Cells(J, "B") = "" Then Cells(J, "A").ClearContents
'        Next J
'        ' 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 UCase(MonthName(Month(LaDate))) = UCase(Split(Sh.Name, " ")(0)) Then
'            ' Si la colonne B et la colonne C est vide on efface la date
'            Range("A" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
'        End If
'    End If
'End Sub