Microsoft 365 Format date dans formule

FCMLE44

XLDnaute Impliqué
Supporter XLD
Bonjour

Dans ce fichier, j'ai une formule concatener mais la date apparait sous le mauvais format

Pourriez vous m'aider svp

Merci
 

Pièces jointes

  • Classeur1.xlsx
    9.7 KB · Affichages: 15
Solution
Voyez ce fichier (2) avec la macro dans la feuille "Salariés" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B16]) Is Nothing Then Exit Sub
With Sheets("Feuil1").[C4]
    If IsDate([B16]) Then
        .Value = "(dont une ancienneté groupe au " & CDate([B16]) & ")"
        With .Characters(32, 10).Font
            .Bold = True 'gras
            .Color = vbRed 'rouge
        End With
    Else
        .Value = ""
    End If
End With
End Sub
Formule en C2 de "Feuil1" =SI(ESTNUM(Salariés!B16);Salariés!B16;"")

Nairolf

XLDnaute Accro
Salut,

Dans Excel, toutes les dates sont en fait des nombres (de jours) décimaux (le premier jour étant le 01/01/1900), pour le mettre en texte il faut lui dire le format souhaité :
Code:
=CONCATENER("(dont une ancienneté groupe au ";TEXTE(C2;"jj/mm/aaaa");" ";")")
 

job75

XLDnaute Barbatruc
Bonjour FCMLE44, Nairolf, djidji59430,

Voyez le fichier .xlsm joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
With [C4]
    If IsDate([C2]) Then
        .Value = "(dont une ancienneté groupe au " & CDate([C2]) & ")"
        With .Characters(32, 10).Font
            .Bold = True 'gras
            .Color = vbRed 'rouge
        End With
    Else
        .Value = ""
    End If
End With
End Sub
A+
 

Pièces jointes

  • Classeur(1).xlsm
    16.7 KB · Affichages: 5

job75

XLDnaute Barbatruc
Voyez ce fichier (2) avec la macro dans la feuille "Salariés" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B16]) Is Nothing Then Exit Sub
With Sheets("Feuil1").[C4]
    If IsDate([B16]) Then
        .Value = "(dont une ancienneté groupe au " & CDate([B16]) & ")"
        With .Characters(32, 10).Font
            .Bold = True 'gras
            .Color = vbRed 'rouge
        End With
    Else
        .Value = ""
    End If
End With
End Sub
Formule en C2 de "Feuil1" =SI(ESTNUM(Salariés!B16);Salariés!B16;"")
 

Pièces jointes

  • Classeur(2).xlsm
    19.1 KB · Affichages: 3

FCMLE44

XLDnaute Impliqué
Supporter XLD
Merci. Cela fonctionne
Comme j'avais deja un worsheet change, j'ai du enlever la première partie
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mois As Variant, findemois As Variant

    If Target.Address = "$D$20" Then
        If Target = "" Then Exit Sub
            Call ecriture
    End If
       '****************************************** Masquer/afficher************************
    If Target.Address = "$D$18" Then
        Application.ScreenUpdating = False
        Sheets("Courriers").Range("28:28,232:289").EntireRow.Hidden = False
        Range("20:69").EntireRow.Hidden = False
        Select Case Target.Value
        Case "Démission"
            ActiveSheet.Range("20:23").EntireRow.Hidden = True
            ActiveSheet.Range("41:69").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Fin de contrat Apprentissage", "Fin de contrat Professionnalisation", "Licenciement Faute Grave"
            ActiveSheet.Range("20:48").EntireRow.Hidden = True
            ActiveSheet.Range("41:69").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Décès"
            ActiveSheet.Range("20:28").EntireRow.Hidden = True
            ActiveSheet.Range("41:69").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289,28:28").EntireRow.Hidden = True
        Case "Fin de Contrat à Durée Déterminée"
            ActiveSheet.Range("20:28").EntireRow.Hidden = True
            ActiveSheet.Range("46:69").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Licenciement Autres"
            ActiveSheet.Range("41:46").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
            MsgBox ("Veuillez saisir la date de notification en cellule B18")
            ActiveSheet.Range("B18").Activate
        Case "Retraite"
            ActiveSheet.Range("21:23").EntireRow.Hidden = True
            ActiveSheet.Range("41:46").EntireRow.Hidden = True
            Sheets("Courriers").Range("28:28").EntireRow.Hidden = True
            
            mois = Month(Range("B17")) + 1
            If mois = 13 Then
                mois = 1
                an = Year(Range("B17")) + 1
            Else
                an = Year(Range("B17"))
            End If
            findemois = CDate("01/" & mois & "/" & an) - 1
            If Range("B17") <> findemois Then
                MsgBox ("Attention, un départ en retraite ne doit jamais avoir lieu au début ni même en cours de mois. Uniquement le dernier jour du mois. Merci, par conséquent de modifier la date de sortie en cellule B17. EN CAS D'INFORMATION CONTRAIRE, MERCI DE PRENDRE CONTACT AVEC VOTRE RESPONSABLE DE GROUPE")
              Range("B17") = ""
            End If
            
            Case "Rupture Conventionnelle"

            ActiveSheet.Range("21:28").EntireRow.Hidden = True
            ActiveSheet.Range("41:46").EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        End Select
    End If
        '****************************************** Actions sur Courrier************************
    If Intersect(Target, [B16]) Is Nothing Then Exit Sub
    With Sheets("Courriers").[C198]
    If IsDate([B16]) Then
        .Value = "(dont une ancienneté groupe au " & CDate([B16]) & ")"
        With .Characters(32, 10).Font
            .Bold = True 'gras
            .Color = vbBlack 'noir
        End With
    Else
        .Value = ""
    End If
End With
End Sub
 

Discussions similaires

Réponses
9
Affichages
170
Réponses
6
Affichages
123

Statistiques des forums

Discussions
312 109
Messages
2 085 384
Membres
102 878
dernier inscrit
asmaa