Mettre H6 au lieu de H4 si frais chevauchent d'un mois sur l'autre sinon H4

Bonjour le forum

Modifier macro pour lui faire afficher ce qui est dit dans le titre

Sub InsertCommentaires()
 Dim cmt As Comment
    Set cmt = Selection.AddComment
    With cmt.Shape
      .Width = ActiveCell.Width
      .Height = ActiveCell.Height
      .Left = ActiveCell.Left
      .Top = ActiveCell.Top
      With .TextFrame
       .Characters.Font.Name = "Arial"                    'Police
       .Characters.Font.FontStyle = "Gras italique"       'Style
       .Characters.Font.Size = 10.5                       'Taille police
       .Characters.Font.ColorIndex = 5                    'Couleur commentaires bleu
       .HorizontalAlignment = xlCenter                    'Centrer texte horizontalement
       .Characters.Text = "Frais établis ce jour: Période du: " & Range("H2").Text & " au " & Range("H3").Text & " Montant: " & Range("H6").Text  'Mettre H6 pour chevauchement d'un mois sur l'autre sinon H4
       .Characters(35, 3).Font.ColorIndex = 2             'blanc à partir du 35éme caractère,2 caractères
       .Characters(38, 4).Font.ColorIndex = 2             'blanc à partir du 38éme caractère,2 caractères
       .Characters(42, 6).Font.ColorIndex = 2             'blanc à partir du 41éme caractère,4 caractères
       .Characters(51, 3).Font.ColorIndex = 2             'blanc à partir du 50éme caractère,2 caractères
       .Characters(58, 6).Font.ColorIndex = 2             'blanc à partir du 53éme caractère,2 caractères
       .Characters(54, 4).Font.ColorIndex = 2             'blanc à partir du 56éme caractère,4 caractères
       .Characters(72, 8).Font.ColorIndex = 2             'blanc à partir du 71éme caractère,3 caractères.
      End With
      .Fill.ForeColor.SchemeColor = 10                    'Couleur fond commentaires
      .Line.Weight = 1.5                                  'Epaisseur bordure Commentaires
      .Line.ForeColor.SchemeColor = 12                    'Couleur bordure
       ActiveCell.Comment.Visible = True                  'Afficher/Masquer les commentaires
    End With
End Sub

Formule cellule H4

=SOMME.SI($G$6:$G$36;">="&H2;$D$6:$D$36)-SOMME.SI($G$6:$G$36;">"&H3;$D$6:$D$36)

Formule cellule H6

='Février 2022'!H4+H4

Ça fait le calcul dans cellule H4 pour le même mois sinon H6 dans macro si les mois chevauchent

Ceci est un exemple

Merci pour vos éventuels retours

Cordialement

Bonjour le forum

Voici un fichier épuré

Lorsque les frais chevauchent d'un mois sur l'autre il faut taper dans cellules H2 et H3 exemple janvier 24 au 31 janvier

En H3 le calcul se fait. Je double clique sur la cellule C22 de Janvier par exemple ça affiche les dates de début, de fin et le montant pour la période du 10 au 17 janvier

Ensuite les frais étant établis le 05 février les mois se chevauchent donc on est obligé de faire du 24 janvier au 31 janvier puis ensuite du1/02 au 05/02

Mais il faut passer par un rappel du 24 au 31 janvier comment?

La date des frais à établir est aléatoire

Je ne sais pas.

Macro?

Merci pour vos éventuels retours

Cordialement

Formule?

Bonjour le forum

Ça se passe ici mais comment le lui faire dire dans macro

Sub InsertCommentaires

       .Characters.Text = "Frais établis ce jour: Période du: " & Range("H2").Text & " au " & Range("H3").Text & " Montant: " & Range("H6").Text

Si ça chevauche sur 2 mois il faut mettre H6

Si c'est dans le mois il faut mettre H4

Merci pour vos éventuels retours

Cordialement

Bonjour,

Sub InsertCommentaires()

Dim cmt As Comment
Dim DateDebut As Date, DateFin As Date
Dim CelluleCmt As Range
Dim Message As String

    With ActiveSheet
         Set CelluleCmt = .Range("D1")
         DateDebut = CDate(.Range("H2")): DateFin = CDate(.Range("H3"))

         If Month(DateFin) = Month(DateDebut) And Year(DateFin) = Year(DateDebut) Then
            Message = "Frais établis ce jour: Période du: " & .Range("H2").Text & " au " & .Range("H3").Text & " Montant: " & .Range("H4").Text  'Mettre H6 pour chevauchement d'un mois sur l'autre sinon H4
         Else
            Message = "Frais établis ce jour: Période du: " & .Range("H2").Text & " au " & .Range("H3").Text & " Montant: " & .Range("H6").Text  'Mettre H6 pour chevauchement d'un mois sur l'autre sinon H4
         End If

         With CelluleCmt
               If Not .Comment Is Nothing Then .Comment.Delete
              .Select
         End With

         Set cmt = CelluleCmt.AddComment
         With cmt.Shape
              .Width = CelluleCmt.Width
              .Height = CelluleCmt.Height
              .Left = CelluleCmt.Left
              .Top = CelluleCmt.Top

              With .TextFrame
                     .Characters.Font.Name = "Arial"                    'Police
                     .Characters.Font.FontStyle = "Gras italique"       'Style
                     .Characters.Font.Size = 10.5                       'Taille police
                     .Characters.Font.ColorIndex = 5                    'Couleur commentaires bleu
                     .HorizontalAlignment = xlCenter                    'Centrer texte horizontalement
                     .Characters.Text = Message ' "Frais établis ce jour: Période du: " & Range("H2").Text & " au " & Range("H3").Text & " Montant: " & Range("H6").Text  'Mettre H6 pour chevauchement d'un mois sur l'autre sinon H4
                     .Characters(35, 3).Font.ColorIndex = 2             'blanc à partir du 35éme caractère,2 caractères
                     .Characters(38, 4).Font.ColorIndex = 2             'blanc à partir du 38éme caractère,2 caractères
                     .Characters(42, 6).Font.ColorIndex = 2             'blanc à partir du 41éme caractère,4 caractères
                     .Characters(51, 3).Font.ColorIndex = 2             'blanc à partir du 50éme caractère,2 caractères
                     .Characters(58, 6).Font.ColorIndex = 2             'blanc à partir du 53éme caractère,2 caractères
                     .Characters(54, 4).Font.ColorIndex = 2             'blanc à partir du 56éme caractère,4 caractères
                     .Characters(72, 8).Font.ColorIndex = 2             'blanc à partir du 71éme caractère,3 caractères.
               End With
               .Fill.ForeColor.SchemeColor = 10                    'Couleur fond commentaires
               .Line.Weight = 1.5                                  'Epaisseur bordure Commentaires
               .Line.ForeColor.SchemeColor = 12                    'Couleur bordure
               .Visible = True                                     'Afficher/Masquer les commentaires
           End With

    End With

     Set CelluleCmt = Nothing:  Set cmt = Nothing
End Sub

Nb : Trop de couleurs nuit à la compréhension.

Bonjour le forum

Je viens de trouver à l'instant

Sub InsertCommentaires()
 Dim cmt As Comment
    Set cmt = Selection.AddComment
    With cmt.Shape
      .Width = ActiveCell.Width
      .Height = ActiveCell.Height
      .Left = ActiveCell.Left
      .Top = ActiveCell.Top
      With .TextFrame
       .Characters.Font.Name = "Arial"                    'Police
       .Characters.Font.FontStyle = "Gras italique"       'Style
       .Characters.Font.Size = 10.5                       'Taille police
       .Characters.Font.ColorIndex = 5                    'Couleur commentaires bleu
       .HorizontalAlignment = xlCenter                    'Centrer texte horizontalement
       .Characters.Text = "Frais établis ce jour: Période du: " & Range("H2").Text & " au " & Range("H3").Text & " Montant: " & _
          IIf(Month(Range("H2")) = Month(ActiveCell.Offset(, 4)), Range("H4").Text, Range("H6").Text)
       .Characters(35, 3).Font.ColorIndex = 2             'blanc à partir du 35éme caractère,2 caractères
       .Characters(38, 4).Font.ColorIndex = 2             'blanc à partir du 38éme caractère,2 caractères
       .Characters(42, 6).Font.ColorIndex = 2             'blanc à partir du 41éme caractère,4 caractères
       .Characters(51, 3).Font.ColorIndex = 2             'blanc à partir du 50éme caractère,2 caractères
       .Characters(58, 6).Font.ColorIndex = 2             'blanc à partir du 53éme caractère,2 caractères
       .Characters(54, 4).Font.ColorIndex = 2             'blanc à partir du 56éme caractère,4 caractères
       .Characters(72, 8).Font.ColorIndex = 2             'blanc à partir du 71éme caractère,3 caractères.
      End With
      .Fill.ForeColor.SchemeColor = 10                    'Couleur fond commentaires
      .Line.Weight = 1.5                                  'Epaisseur bordure Commentaires
      .Line.ForeColor.SchemeColor = 12                    'Couleur bordure
       ActiveCell.Comment.Visible = True                  'Afficher/Masquer les commentaires
    End With
End Sub

Bonjour Eric Kergresse

Je viens de trouver à l’instant

Quand ton mail est arrivé je testais le mien

Je vais maintenant tester le tient

Merci à toi car la seule réponse

Bonne fin de soirée

Encore merci

Cordialement

Bonjour le forum

Dans la continuité du même programme comment pourrait-on faire afficher par double click ou autre (formule) la somme par exemple Janvier 62.40€ payé avec la paye de février ou mars?

Merci pour vos éventuels retours

Cordialement