Autres [RÉSOLU] Peut-on arriver à "schunter" la difficulté que j'ai crée moi-même?

[un internaute]

Bonjour le forum
Il y a des années que j'ai voulu faire afficher la père lettre en Majuscule des dates colonne A
Ça fonctionne bien quand c'est la date du jour mais quand j'anticipe un futur R.V par exemple 02/02/2026
Tout d'abord il faut que la date colonne G soit la même donc je fait un double click cellule A2 pour faire afficher la colonne G et modifier la date cellule A4 soit 02/02/2026 mais la 1ère lettre de la date colonne A est en minuscule.
Donc il faut la retaper à la main... soit LUNDI 02 Février 2026
Quel CON à l'époque mais je pense aussi encore maintenant!!
Merci pour vos éventuels retours
Cordialement

 

[sylvanu]

Bonjour,
Si j'ai bien compris la demande, rajoutez dans la feuille "Transport VSL" :

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("A3:A500"), Target) Is Nothing Then
    Target = Application.Proper(Format(Target, "dddd dd mmm yyyy"))
End If
End Sub

 

[un internaute]

Bonjour sylvanu
Tu as bien compris la demande c'est exactement ça
Mais pourquoi Mardi 03 Nov 2026 au lieu de Novembre

 

[sylvanu]

Re,
Oups, c'est "mmmm" et non "mmm"

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("A3:A500"), Target) Is Nothing Then
    Target = Application.Proper(Format(Target, "dddd dd mmmm yyyy"))
End If
End Sub

 

[un internaute]

Re
SUPER
J'aurais du le voir moi pas attentif du tout... ah! la vieillesse et la maladie
SUPER un GRAND merci à toi
Bonne fin de soirée

 

[un internaute]

Je m'excuse encore si c'est possible
Peut-on faire afficher la date G sous le format affiché au lieu de la taper
J'ai fait
J'ai bricolé quelque chose mais pour effacer la date du 11 Février 2026 (exemple) il faut double cliquer 2 fois cellule A4 pour revenir à la date du jour puis ça efface la ligne y compris Heure de R.V
C'est chiant...Pourquoi pas un seul double click pour effacer?
C'est le seul truc qui fait C$$$$R!!!

 

[sylvanu]

Rien compris. 😅
En fait vous voulez remplacer le double click par un seul clic ?
Sinon soyez plus précis.

 

[un internaute]

Bonjour sylvanu
Et pourtant...
Si je veux inscrire la date du jour je double click sur cellule A4 ça affiche Samedi 04 Octobre 2025 ainsi que dans colonne G
J'enregistre tout va bien
Si je veux modifier la date toujours cellule A4 je tape par exemple 02/02/2026 ça affiche bien ainsi que dans colonne G4
Je veux effacer la nouvelle date 02/02/2026 je fait un double click cellule A4 mais IL FAUT QUE ÇA REPASSE PAR LA DATE DU JOUR Samedi 04 Octobre 2026 pour que la toute la ligne de A4 à H4 à la demande Effacer la date?
Ça se passe dans cette macro
Si j'inverse la ligne en commentaires
Je ne peux pas être plus précis mais toutes mes excuses si il y a incompréhension

 

[un internaute]

Ça se passe ici suivant que j'inverse ces 2 lignes en commentaires ou non
Si je met la 2ème en non commentaires je ne peux plus afficher la date du jour

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    If DerLig < 3 Then DerLig = 3
    If Not Intersect(Range("A3:A" & DerLig + 1), Target) Is Nothing Then
        Cancel = True
        Application.EnableEvents = False
        If IsEmpty(Target) And Application.WorksheetFunction.CountIf(Range("A2:A" & DerLig), Format(Date, "dddd dd mmmm yyyy")) > 0 Then
            MsgBox "Cette date existe déjà"
            GoTo Sortie
        End If
        If Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0)) Then    'Normalement c'est cette ligne qui est la bonne pour indiquer la date du jour
'        If Target <> "" And Not IsError(Application.Match(CSng(CDate(Trim(Mid(Target, InStr(Target, " "))))), Columns("G"), 0)) Then   'cette ligne en commentaire
            If Target.Value <> "" Then
                If MsgBox("Effacer la date?", vbYesNo) = vbYes Then
                    On Error Resume Next
                    Target.Resize(, 8).SpecialCells(xlCellTypeConstants, 23).ClearContents
                    On Error GoTo 0
                    Target.Resize(, 8).Interior.ColorIndex = 8
                End If
            End If
          Else
            Target.Offset(, 6).Value = Date
            Target = Application.Proper(Format(Date, "dddd dd mmmm yyyy"))
          End If
    End If
Sortie:
    Application.EnableEvents = True
    Range("A1").Select
End Sub

 

[wDog66]

Bonjour à tous, salut 1internaute

Pourquoi avoir le BeforeDoubleClick dans 2 endroits différents 🤔
1 dans ThisWorkbook
1 dans la feuille "TRANSPORT VSL"

Ca fou forcément le binz, non.

Voici ma vision de la chose 😜

 

[bsalv]

même remarque que wDog66, que je salute.
mais je déplace la colonne G vers la colonne A et cela sera plus pratique.
Et pourquoi pas un tableau structuré ?

 

[Dranreb]

Bonjour.
Moi, je propose ça …

 

[un internaute]

Bonjour à tous et merci pour vos contributions mais trop difficile pour moi
J'ai encore modifié le programme pour avoir des R.V le même jour car ce n'était pas prévu
Le seul truc c'est supprimer une ligne

 

[un internaute]

Mis ça dans ThisWorkbook
Ça fonctionne
Vous cassez pas la tête les "amis"!!
Merci à vous tous
Cordialement

       '*****************************************************************************
    If (Target <> "" And Not IsError(Application.Match(CSng(Date), Columns("G"), 0))) Or Target <> "" And Target.Value <> Date Then
        If Target.Value <> "" Then
                On Error Resume Next
                Target.Resize(, 8).SpecialCells(xlCellTypeConstants, 23).ClearContents
                On Error GoTo 0
                Target.Resize(, 8).Interior.ColorIndex = 8
                GoTo Sortie
        End If
        Else
       '*****************************************************************************

 

[un internaute]

Bonjour le forum
Je voudrais mettre en double click la macro ci-dessous
Mais où?
Cordialement
Merci pour vos éventuels retours?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect(Range("H3:H500"), Target) Is Nothing Then
  UsfInfos.Show 0
  End If
End Sub