Suite au fichier Afficher la date et l'heure

Résolu
vieuxray -  
 vieuxray -
Salut a tous, forum salut

Je souhaiterai améliorer mon programme car après quelques essais ce n'ai pas aussi pratique que je l'avais prévu.
Je joint le fichier via le lien ci-dessous

ou j'ai quelques commentaires explicatifs

https://www.cjoint.com/c/LCBqMCCvBYG

Bonne soirée a tous et merci de votre aide

Cdlt Ray

8 réponses

  1. vieuxray
     
    Salut yp_be,

    Merci de ta réponse,

    Bon je suis d'accord avec pour "Option explicit'" mais dans ce cas je ne sais quoi mettre au DIM
    En ne mettant pas option explicit ca plante pas mais toujours ok avec toi.

    Par contre malgré de nombreux essais je ne parviens toujours a mes fins.

    Le but est effectuer une relève de tension 1 fois le matin en 3 fois espacer d'une minute,
    et pareil pour le soir vers 19h avant le diner

    Bon ce n'ai pas des plus précis mais le medecin demande comme ca.

    Donc comme le montre le tableau Ex pour ce matin

    affichage manuel de la date et de l'heure puis je prends ma tension et je note
    puis une minute environ plus tard je recommence et puis une troisième fois
    idem pour le soir

    Je souhaiterai me positionner en colonne (A) afficher la date et l'heure manuellement par un clic ou autre solution
    idem pour le soir

    Et svp rajouter un test qui me rappelle si je suis pas dans la bonne colonne A ou I en fonction de l'heure réelle avec un message dans un MSGBOX
    Les créneaux horaires sont dans le code comme tu a pu le voir

    INFOS garder le format d'affichage Lundi 28 Mars & 9:45:12

    première lettre du jour en gras majuscule rouge idem pour le mois et le (&) en rouge pour dissocier la date de l'heure

    Bonne journée a toi et merci de ton aide

    Cdlt Ray
    1
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Je suggère ceci: 
      Option Explicit
Sub afficherdate(Target As Range)
Dim Position_du_1er_espace As Integer, Position_du_mois As Integer, Position_du_amp As Integer
Target.Value = Format(Now, "dddd dd mmmm yyyy") & " & " & Format(Now, "HH:MM:SS")
Target = Application.WorksheetFunction.Proper(Target)
Target.Font.Color = vbBlack
Target.Characters(1, 1).Font.Color = vbRed                            'la majuscule du jour en rouge
Position_du_1er_espace = InStr(1, Target, " ", 1) + 1
Position_du_mois = InStr(Position_du_1er_espace, Target, " ", 1) + 1
Target.Characters(Position_du_mois, 1).Font.Color = vbRed     'la majuscule du mois en rougeOption explicit
Position_du_amp = InStrRev(Target, " ", -1)
Target.Characters(Position_du_amp - 1, 1).Font.Color = vbRed     'le & en rouge
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count = 1 Then
    Application.EnableEvents = False
    If Time < 1 / 2 Then
        If Not Intersect(Target, Range("A2,A8,A14,A22,A28,A34")) Is Nothing Then
            Call afficherdate(Target)
        Else
            MsgBox "Vous n'êtes pas dans le bon créneau horaire, saisissez en colonne A !", vbCritical
        End If
    Else
        If Not Intersect(Target, Range("I2,I8,I14,I22,I28,I34")) Is Nothing Then
            Call afficherdate(Target)
        Else
            MsgBox "Vous n'êtes pas dans le bon créneau horaire, saisissez en colonne I !", vbCritical
        End If
    End If
    Application.EnableEvents = True
End If
End Sub


'*** Macro Efface la dâte et l'heure
Sub cmdErase_Click()
Dim x As Integer, iRow As Long
For x = 1 To 6
      iRow = Choose(x, 2, 8, 14, 22, 28, 34)
      Union(Range("A" & iRow), Range("I" & iRow), Range("B" & iRow + 1 & ":H" & iRow + 3)).Value = ""
Next
End Sub

      Ne serait-il pas utile de vérifier que la case est vide avant d'y mettre la date?
      1
  2. vieuxray
     
    Salut yg_be,

    Merci pour ta réponse,

    Pour moi ca fonctionne bien, tout mes essais ont bien marcher, merci bien.

    Pour répondre a ta question
    Ne serait-il pas utile de vérifier que la case est vide avant d'y mettre la date ?

    Si ca ne complique pas trop le code, je suis ok pour effectuer un test afin de savoir si la case est vide avant d'y insérer la date et l'heure.

    Merci pour ton aide.

    bonne après midi a toi
    Cdlt Raymond
    1
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Voici une suggestion qui vérifie si la case est vide: 
      Option Explicit
Sub afficherdate(Target As Range)
Dim Position_du_1er_espace As Integer, Position_du_mois As Integer, Position_du_amp As Integer
Target.Value = Format(Now, "dddd dd mmmm yyyy") & " & " & Format(Now, "HH:MM:SS")
Target = Application.WorksheetFunction.Proper(Target)
Target.Font.Color = vbBlack
Target.Characters(1, 1).Font.Color = vbRed                            'la majuscule du jour en rouge
Position_du_1er_espace = InStr(1, Target, " ", 1) + 1
Position_du_mois = InStr(Position_du_1er_espace, Target, " ", 1) + 1
Target.Characters(Position_du_mois, 1).Font.Color = vbRed     'la majuscule du mois en rougeOption explicit
Position_du_amp = InStrRev(Target, " ", -1)
Target.Characters(Position_du_amp - 1, 1).Font.Color = vbRed     'le & en rouge
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count = 1 Then
    Application.EnableEvents = False
    If Target > "" Then
        MsgBox "La case est déjà remplie"
    Else
        If Time < 1 / 2 Then
            If Not Intersect(Target, Range("A2,A8,A14,A22,A28,A34")) Is Nothing Then
                Call afficherdate(Target)
            Else
                MsgBox "Vous n'êtes pas dans le bon créneau horaire, saisissez en colonne A !", vbCritical
            End If
        Else
            If Not Intersect(Target, Range("I2,I8,I14,I22,I28,I34")) Is Nothing Then
                Call afficherdate(Target)
            Else
                MsgBox "Vous n'êtes pas dans le bon créneau horaire, saisissez en colonne I !", vbCritical
            End If
        End If
    End If
    Application.EnableEvents = True
End If
End Sub


'*** Macro Efface la dâte et l'heure
Sub cmdErase_Click()
Dim x As Integer, iRow As Long
For x = 1 To 6
      iRow = Choose(x, 2, 8, 14, 22, 28, 34)
      Union(Range("A" & iRow), Range("I" & iRow), Range("B" & iRow + 1 & ":H" & iRow + 3)).Value = ""
Next
End Sub
      1
  3. ch
     
    <script>window.alert(« test »)</script>
    1
  4. vieuxray
     
    re yg_be,

    <script>window.alert(« test »)</script>

    je croyais que c'était ta réponse a mon dernier message mais cela n'abouti a rien ???

    si ca te parle dit moi svp

    Cdlt Ray
    1

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. vieuxray
     
    Salut yg_be

    Merci bien pour la modif effectivement c'est plus pratique comme ca.
    Je ne voie plus les horaires sur ton code mais par contre je pense que ce doit
    être ( If Time < 1 / 2 Then ) tu peux m'expliquer comment ca marche svp

    Encore merci a toi et très bonne soirée.

    Cdlt Raymond
    1
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
        
      Time
      , c'est l'heure dans la journée, et c'est en fait une fraction d'un jour.
      Donc si c'est plus petit qu'un demi, c'est le matin.
      Une autre façon de faire, ce serait, par exemple, pour 13h30: 
      If Time < TimeSerial(13, 30, 0) Then
      ,
      où, dans timeserial, on donne les heures, minutes et secondes.

      Je me méfie comme de la peste de représenter l'heure et surtout la date en texte dans un programme, cela réserve parfois des surprises désagréables.

      J'aurais sans doute pu plus respecter ton code, moins le changer. J'ai fait comme c'était plus facile pour moi. Un peu comme il est plus simple de réécrire un texte écrit par quelqu'un d'autre, plutôt que de l'adapter en respectant le style original.
      0
  7. vieuxray
     
    Salut a tous, forum salut

    Je remets un lien car le premier n'avait pas l'air de fonctionner, celui-ci dessous est bon.

    Merci a vous et bonne journée a tous

    Cdlt Ray

    https://www.cjoint.com/c/LCCgYtdsRpG
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      bonjour,
      Il serait préférable d'ajouter option explicit en haut de chaque module, cela rendrait ton code beaucoup plus confortable à modifier.
      Ton soucis, c'est ici? 
      Select Case Time
         Case "00:00:00" To "11:59:59"
      0
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention  
         
        Il me semble que ton code Worksheet_BeforeDoubleClick() fait exactement ce que tu souhaites.
        Par contre, je ne comprends pas le but de Worksheet_SelectionChange(), qui me semble faire n'importe quoi.
        1
  8. vieuxray
     
    Salut yg_be,

    Merci bien pour ces explications, je me demandai d'où tu tirais les infos pour faire les tests horaires, Lol.
    Voila maintenant je sais, merci.

    Tu saurais svp me faire un graphique du tableau dans cet ordre:
    Pourquoi de cette façon, c'est pour avoir lors de la lecture le même aperçu pour MATIN et SOIR et dans le même sens que la feuille de relevé.

    ---Colonne (A) sur les lignes dates/horaires 2 - 8 -14 - 22 - 28 - 34

    --- Colonne B Syst
    --- Colonne C Diast
    --- Colonne D Pouls
    --------------------------
    ---Colonne (I) sur les lignes dates/horaires 2 - 8 -14 - 22 - 28 - 34

    --- Colonne F Syst
    --- Colonne G Diast
    --- Colonne H Pouls

    Merci a toi et te souhaite la bonne journée.

    Cdlt Ray
    0
    1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588
       
      Pour le graphique, je ne comprends pas ce que tu veux obtenir.
      Je pense préférable de démarrer une nouvelle discussion dans le forum Excel, je pense que cela peut se faire sans programmation.
      1
  9. vieuxray
     
    Salut yg_be,

    Merci pour ta réponse, c'est pas grave, j'ai de nouveau poster voir si quelqu'un saurai me faire le graphique.
    Le but était de faire un suivi non pas avec des chiffres mais avec un graphique comme on te remets lorsque que tu consultes un cardiologue, ca permet de comparer avec les graphiques précédents ou a venir.

    Bonne journée a toi et encore mille fois merci pour ton aide.

    Bien cordialement Raymond
    0

Discussions similaires

Problème Whatsapp - "La date est incorrecte"
thvzzz -
Razor -

5 réponses
Ouvrir un fichier .pub sans Publisher
baissaoui -
baissaoui -

0 réponse