Autres Traitement des formats date

V

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

  • Manip_Plage_Date.xlsm
    22.1 KB · Affichages: 7
Trier par date Trier par votes
V

VIARD

XLDnaute Impliqué
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

  • Manip_Plage_Date.xlsm
    23.8 KB · Affichages: 2
Dernière édition:
Vote positif 0 Vote négatif
D

danielco

XLDnaute Accro
danielco à dit:
Remplace :
VB: 
Cells(Lg + Y, Cl).Value = Format(i & "/" & AnMois, FMT(CHX))
par :
Code: 
                Cells(Lg + Y, Cl).Value = DateValue(i & "/" & AnMois)
                Cells(Lg + Y, Cl).NumberFormat = FMT(CHX)
Cliquez pour agrandir...
Capture d'écran 2024-10-07 140429.png

Daniel
 
Vote positif 0 Vote négatif
V

VIARD

XLDnaute Impliqué
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

  • Manip_Plage_Date.xlsm
    23.3 KB · Affichages: 1
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif

Discussions similaires

V
  • Question
Autres Pseudo_Calendrier_8s
Réponses
0
Affichages
254
VIARD
V
M
  • Question
Problème de format date que pour 3 mois ?
Réponses
2
Affichages
803
Mric
M
F
  • Question
Problème transformer texte en date
Réponses
8
Affichages
2 K
f69815
F
Z
  • Question
prob date pour filtre auto
Réponses
2
Affichages
1 K
zoulou08
Z

Membres actuellement en ligne

1 membres et 33 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 083
Membres
112 654
dernier inscrit
SADIKA