Autres Traitement des formats date

  • Initiateur de la discussion Initiateur de la discussion VIARD
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

VIARD

XLDnaute Impliqué
Bonjour à toutes et tous

Voilà je vous présente un extrait de mon fichier.
Le problème, j'ai un soucis sur ce code, au format date abrégé (jj mmm aaaa),"Format2"
pour 3 mois (Septembre, octobre, novembre) l'affichage est mauvais mélange jour mois et format court ,
les autres mois sont correct --> voici le code: Const Format1 = "dd/mm/yyyy" 'court
Je pense avoir tout vérifié.
AnMois --> ok
Format(i & "/" & AnMois, FMT(CHX)) --> ok
Les 3 TextBox 1,2,3 --> ok
J'ai simplifié au maximum le fichier pour qu'il soit facilement exploitable.

A+
Jean-Paul
 

Pièces jointes

Bonjour @danielco, @TooFatBoy

@danielco, merci pour l'intervention.
J'avais déjà effectué cette manip, et dans cas le format court ne s'affichait pas correctement.
@TooFatBoy
certaines lignes sont en commentaires suite aux manip.
voici le code :
VB:
Sub Plage_Date()
Dim Adr$, Lg%, Cl%, Y%, i%, AnMois$
Dim j(), MJ%, Année&, Fin%, FMT(), CHX%
Dim LeJour(), Mois(), m%, jr%, Gras%

Application.ScreenUpdating = False
'----- adressage plage ------------
Adr = Range("C3").Address 'activecell.Address
Lg = Range(Adr).Row 'numéro ligne
Cl = ColNum(Adr) 'numéro colonne
'-------- Données ------------
Année = Range("K4").Value
m = Range("K5").Value
jr = Range("K6").Value
CHX = Range("K8").Value
Gras = Range("K9").Value
Fin = Range("K10").Value
'----------------------------------
j = Array("", 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
'------ Année Bisextile ------
'Année = 2024 'TextBox1
If m = 2 Then 'si mois Février
    If (Année Mod 4 = 0 And Année Mod 100 <> 0) Or (Année Mod 400 = 0) Then
        MJ = 29
    Else
        MJ = 28
    End If
End If
'-------------------------
If MJ <> 29 Then
    MJ = j(m)
Else
    MJ = 29
End If
'-------------------------
Y = 0
AnMois = m & "/" & Année
'-------------------------
'---------------- Court ------- Abrégé --------- Long ---- long + jour semaine -- court + jr Sem. - abrégé + jr Sem. -- Jr. Sem.--
'--------------- Format1------- Format2 ------- Format3 ------- Format4 ------------- Format5 ---------- Format6 ------ Format7 --
'FMT = Array("", "dd/mm/yyyy", "dd mmm yyyy", "dd mmmm yyyy", "dddd dd mmmm yyyy", "dddd dd/mm/yyyy", "dddd dd mmm yyyy", "dddd")
FMT = Array("", Format1, Format2, Format3, Format4, Format5, Format6, Format7)
'---- Format affichage ---
        If jr + Fin > MJ Or Fin = 0 Then
            For i = jr To MJ
                Cells(Lg + Y, Cl).Clear
                Cells(Lg + Y, Cl).HorizontalAlignment = xlRight
                Cells(Lg + Y, Cl).Value = Format(i & "/" & AnMois, FMT(CHX))
                Cells(Lg + Y, Cl).Font.Name = "Tahoma"
                Cells(Lg + Y, Cl).Value = CStr(Cells(Lg + Y, Cl).Value) 'Format texte
'------------- Surbrillance -------------
                If Gras = 1 Then
                    If Y = 0 Or Y = 7 Or Y = 14 Or Y = 21 Or Y = 28 Then
                        With Cells(Lg + Y, Cl).Font
                            .ColorIndex = 1
                            .Bold = True
                        End With
                    End If
                Else
                    Cells(Lg + Y, Cl).Font.Bold = False
                End If
'-----------------------------------------
                Cells(Lg + Y, Cl).EntireColumn.AutoFit
                Y = Y + 1
            Next i
        ElseIf jr + Fin < MJ Then
            For i = jr To jr + Fin
                Cells(Lg + Y, Cl).Clear
                Cells(Lg + Y, Cl).HorizontalAlignment = xlRight
                Cells(Lg + Y, Cl).Value = Format(i & "/" & AnMois, FMT(CHX))
                MsgBox Format(i & "/" & AnMois, FMT(CHX))
                Cells(Lg + Y, Cl).Font.Name = "Tahoma"
'                Cells(Lg + Y, Cl).Value = CStr(Cells(Lg + Y, Cl).Value)
'--------------- Surbrillance -------------
                If Gras = 1 Then
                    If Y = 0 Or Y = 7 Or Y = 14 Or Y = 21 Or Y = 28 Then
                        With Cells(Lg + Y, Cl).Font
                            .ColorIndex = 1
                            .Bold = True
                        End With
                    End If
                Else
                    Cells(Lg + Y, Cl).Font.Bold = False
                End If
'-----------------------------------------
                Cells(Lg + Y, Cl).EntireColumn.AutoFit
                Y = Y + 1
            Next i
        End If
Application.ScreenUpdating = True
End Sub
'==========================

@TooFatBoy
Nota: Sur le formulaire, pour toutes les données j'ai mis une liste déroulante.
et un bouton d'effacement colonne "C".
merci pour tes conseils.
dans le code j'ai placé une boîte de dialogue, ici l'info est bonne mais n'est pas retranscrit

sur le formulaire, il y a donc quelque part un formatage que n'est pas bon.
 

Pièces jointes

Dernière édition:
Bonjour à tous

@danielco
J'ai effectué et testé les modifications.
çà super bien, comme quoi un œil neuf est bien utile.
Je me suis entêté, il fallait décomposer.
Je te remercie infiniment, çà m'enlève une épine du pied.
@TooFatBoy, merci d'avoir regardé.

amicalement.

Avec le fichier terminé.
voici la partie modifier.


VB:
            For i = jr To jr + Fin
                Cells(Lg + Y, Cl).Clear
                Cells(Lg + Y, Cl).HorizontalAlignment = xlRight
                Cells(Lg + Y, Cl).Value = DateValue(i & "/" & AnMois)
                Cells(Lg + Y, Cl).NumberFormat = FMT(CHX)
                Cells(Lg + Y, Cl).Font.Name = "Tahoma"
'--------------- Surbrillance -------------
                If Gras = 1 Then
                    If Y = 0 Or Y = 7 Or Y = 14 Or Y = 21 Or Y = 28 Then
                        With Cells(Lg + Y, Cl).Font
                            .ColorIndex = 1
                            .Bold = True
                        End With
                    End If
                Else
                    Cells(Lg + Y, Cl).Font.Bold = False
                End If
'-----------------------------------------
                Cells(Lg + Y, Cl).EntireColumn.AutoFit
                Y = Y + 1
            Next i
 

Pièces jointes

Dernière édition:
Désolé, je n'ai pu ouvrir ton fichier que maintenant, mais je vois que tu as déjà trouvé une solution. 👍

Donc juste pour info : perso, pour les dates j'essaye d'utiliser .Value2 qui (si j'ai bien compris) utilise la donnée brute sans la transformer.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Z
Réponses
2
Affichages
1 K
zoulou08
Z
Retour