Afficher la date dans une cellule Résolu/Fermé

Question

Bonjour a tous, forum bonjour,

Configuration: Windows 10/ Edge  / Excel 2007 

Je souhaiterai svp afficher la date sur un clic droit dans la cellule E34.

Le code ci-dessous fonctionne MAIS je voudrais mettre un format autre que celui qui s'affiche par défaut comme "11/02/2020 10:55" je souhaiterai plutôt (11 Févr 2020) et uniquement la date du jour.

Mais la date afficher ne doit pas changer automatiquement tous les jours ou a chaque fois que j'ouvre le fichier.

Mais uniquement changer lorsque je fait un clic droit sur E34.

1) De plus le fait de supprimer Cancel = True me provoque 

- Soit la date s'affiche sur toute la colonne E
- Soit je n'ai plus le menu du clic-droit, bien embêtant pour effacer quelque chose.

Merci a vous pour votre aide.

Bonne journée a tous.

Cdlt Ray

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 5 Then Target.Value = Now

'*** Cancel = True

End Sub

yg_be · Answer

bonjour, as-tu essayé d'ajouter dans le if un test de la ligne?
If Target.Column = 5 and target.row=34 Then Target.Value = Now
tu n'as pas expliqué si tu voulais avoir le menu clic-droit aussi sur E34.

duduleray · Answer

Salut yg_be,

Merci pour ta réponse, c'est sympa.

Après quelques essais avec ton code et le mien, je ne pense pas que j'aurai besoin du menu.

La cellule E34 me sert uniquement a afficher la date dans le format souhaiter (11 Févr 2020)

sur un clic droit la date s'affiche en E34.

Demain ou un autre jour je clic droit a nouveau dans la cellule et la date actualiser s'affiche jusqu'au prochain clic droit.

Merci a toi et vu l'heure bonne app, a plus tard.

Cdlt Ray

duduleray · Answer

Re yg_be,

Merci pour ton code ca fonctionne bien.

Pour le format "Date" je n'ai trouver que ce format  11 février 2020 dans le menu format de cellule.

j'aurai bien voulu les noms des mois en abrégés Janv, Févr, Mar, 
la ca rentre dans la cellule E34 Mais dès que l'on va passer dans les mois longs l'affichage va déborder de la cellule et je ne peux pas agrandir cette cellule ni diminuer la police.

Merci pour ton aide.

Cdlt Ray

duduleray · Answer

Re 

Pour le code je sais très bien mais je sais pas pourquoi sur CCM je n'arrive pas toujours a recopier les codes ni mème que pour les balises.

j'ai Windows 10 a jour et Edge aussi mais j'ai toujours Internet explorer 11 a jour portant il y a peut ètre des conflis

Bon alors Non le clic droit n'ai devenu double clic

Mais dans mon code de compta j'avais déjà le clic droit
puis j'ai rajouter le code pour faire afficher la date dans la cellule E34 et du coup je me suis
retrouver avec deux lignes de codes identiques

alors j'ai mis en REM provisoirement le code pour la date en attendant si solution il y aurai .

Voila merci 

Ray

duduleray · Answer

Re 

je prends le temps t'inquiète mais c'est pas toujours facile d'expliquer se que l'on souhaite.

Alors donc erreur de ma part désolé, c'est le clic droit. je me retrouve avec deux lignes identiques donc le plus simple ca serai soit j'abandonne l'affichage de la date.
de toutes façons il faut supprimer une ligne.
Alors d'où ma question peut'on sur un simple clic sur la cellule E34 afficher le date si oui ca résoudrai le problème.

Merci a toi

PS: j'ai bien mis les balises juste pour une ligne de code, j'espère que se sera bon.

Ray

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

duduleray · Answer

Re
voila le code de mon onglet "Compte"
je ne sais pas si ca va t'arranger

Cdlt Ray

Option Explicit
'*** CLIC DROIT CHANGE LA COULEUR DES CELLULES DU TABLEAU EN VERT OU EN GRIS PLAGE E2:P15
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Count > 1 Then Exit Sub
  If Not Intersect(Target, Range("E2:P15")) Is Nothing Then
     Cancel = True                                                'Pour garder le focus sur la cellule activ?e

      With Target.Interior
          .ColorIndex = IIf(.ColorIndex = 16, 4, 16)              'Couleur gris(16), vert clair(4)fond cellule
      End With
           Cells(R, 17).Interior.ColorIndex = 15                  'Place ligne REPERE en gris colonne (R)
  End If
    Calculate                                                     'Pour compter les totaux des cellules mise en gris
End Sub

'*** RECOPIE LA VALEUR DE LA PLAGE LIGNE(E20:P20) MOIS PAR MOIS COLONNE 17(Q) PLAGE Q2:Q26
Public Sub Worksheet_Calculate()
    Application.EnableEvents = False
    C = Month(Now) + 4
    R = [Z1].Value: If R < 2 Then R = 1
    Cells(R, 17).Font.ColorIndex = 10       'Vert fonc?
    Cells(R, 17).Interior.ColorIndex = 15

    With Cells(R, 17).Interior
                     .ColorIndex = 15       'Gris affiche barre rep?re Gris clair
        If Cells(20, C).Text <> Cells(R, 17).Text Then
               R = R + 1: If R > 26 Then R = 2
               [Z1].Value = R
               Cells(R, 17).Value = Cells(20, C).Value
              .ColorIndex = xlNone
        End If
    End With
         Cells(R, 17).Font.ColorIndex = 5    'Bleu
         
'*** Test si "RETARD" o? "SOLDE"
Select Case Range("O35").Value
    Case Is < 0
        With Range("P35")
            .Value = "RETARD"
            .Font.ColorIndex = 3    'Rouge
        End With
    Case Is > 0
        With Range("P35")
            .Value = "SOLDE"
            .Font.ColorIndex = 4    'Vert
        End With
    Case Is = 0
        With Range("P35")
            .Value = ""
            .Font.ColorIndex = xlNone
        End With
End Select
       Application.EnableEvents = True
End Sub

'*** BOUTON POUR EFFACER LA COLONNE(Q)
Public Sub EffaceCellule()
  With Ws
       If MsgBox("Effacer les donn?es de la colonne Q ", vbYesNo, "Demande de confirmation") = vbYes Then
           [Q2:Q26].ClearContents
           [Q2:Q26].Interior.ColorIndex = xlNone
                    Cells(R, 17).Interior.ColorIndex = 15   'Remets ligne REPERE en gris
        Else
         Exit Sub                                                       'Si r?ponse = Non on sort
      End If
  End With
End Sub

'#######################

'*** Pour effacer par double clic les donn?es colonne F31:F34
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
         If Not Intersect(Range("F31:F34"), Target) Is Nothing Then
                  Cancel = True
                  Target.Value = ""
         End If
End Sub

'*** Test et entr?e des donn?es
Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Range("$F$31:$F$34")) Is Nothing Then Exit Sub
Application.EnableEvents = False           '*** D?sactive les autres ?v?nements que pourrait d?clencher la macro

Select Case Target.Value
          Case IsNumeric(Target.Value) And Target.Value = 0 And Not IsEmpty(Target.Value) = False       '*** Si Z?ro entrer
                   Target.Value = ""
                   Target.Select

          Case Is < 0                                 '*** Si chiffre n?gatif
                   Target.Value = ""
                   Target.Select

'*****************************
          Case Is <> ""                               '*** Si cellule n'ai pas vide
                  With Target.Offset(0, 1)
                         .Value = "Versement en attente"
                         .Font.ColorIndex = 3                        '*** Rouge
                         Target.Value = .Offset(0, -1)
           End With

          Case Is = ""                                                    '*** Si cellule vide
                   With Target.Offset(0, 1)
                          .Value = "Versement effectuer"
                          .Font.ColorIndex = 4                        '*** Vert
                          Target.Value = .Offset(0, -1)
          End With

          Case Else: Range("F31:F34").Value = ""
                           Range("G31:G34").Value = ""
End Select
Application.EnableEvents = True              '*** R?active les ?v?nements

If Application.WorksheetFunction.CountA(Range("F31:F34")) = 0 Then Range("G31:G34").ClearContents
End Sub

'*** Permets de descendre d'une ligne Offset(1,-1)   1 pour descendre d'une ligne et -1 pour avance colonne
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
         If Not Intersect(Target, Range("G31:G34")) Is Nothing Then Target.Offset(1, -1).Select
End Sub

'*** Date sur clic droit en REM provisoirement
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
'
'If Target.Column = 5 And Target.Row = 34 Then
'   Target.Value = Format(Date, "dd mmm yyyy")
'   Cancel = True
'End If
'End Sub

duduleray · Answer

Salut yg_be,

J'ai regarder dans format de cellule pour la date et c'est au format normal donc j'ai laisser comme ça.

J'ai toutefois refait des essais mais du coup,  je ne sais pas pourquoi la date change de format avec un double clic sur la cellule E34.

Je te souhaite la bonne journée et merci.

Cdlt Ray

Afficher la date dans une cellule

7 réponses

Discussions similaires