Problème macro en incorporant une autre macro

Version imprimable

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:

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:

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

Bonjour, comme les 2 macros s'exécutent suite à un test conditionnel, en intégrant les 2 test if à la suite l'un de l'autre ça devrait fonctionner.
essaie comme ceci:

Code:

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
36
37
38
39
40
41
42
43
44
45
46
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Obj As Shape, Ligne As Long
    Dim LaDate As Date, J As Long
 
    ' Première partie 
    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
 
         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
            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
    End If
 
    ' Deuxième partie
    If Target.Column = 2 Then
        Application.ScreenUpdating = False
        For J = 6 To 36
            If Cells(J, "B") = "" Then Cells(J, "A").ClearContents
        Next J
 
        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 les colonnes B et C sont vides, on efface la date
            Range("A" & Target.Row) = Application.Proper(Format(LaDate, "dddd dd mmmm yyyy"))
        End If
    End If
 
    Application.ScreenUpdating = True
End Sub

28/08/2024, 12h46
Un Internaute

1 pièce(s) jointe(s)

Bonjour Franc
Non toujours pas

Pièce jointe 658703