Afficher un message dans une MSGBOX

Salut curulis57,

Merci pour ta réponse,

J'essais depuis hier pour adapter ton code a ma nouvelle disposition et j'ai dû merdouiller et du coup

j'ai du mal a rétablir le fonctionnement du programme.

De plus je pige pas ton code pas faute d'avoir essayer

Si tu a un code plus simple que je puisse modifier quand j'en ai le besoin, mes derniers cheveux sont tombés

Voila bonne journée a toi et merci de ton aide.

Cdlt Ray

Envoie le fichier, Ray!

A+

Salut curulis57,

Je croyais l'avoir remis tout a l'heure, désoler.

Bon hé bien voila le fichier, j'ai mis un commentaire dedans, t'inquiète pas je ne change plus

merci a toi et bonne après midi

Cdlt Ray

Salut Ray,

ton fichier arrangé à ma sauce!

Lors du double-clic pour affichage de la date et heure, la macro décide toute seule comme une grande où afficher l'info et positionne le curseur sur la cellule "Systolique - Mesure 1".
Tu remarqueras que j'ai laissé un Popup auto-effaçable que tu as tant cherché dernièrement!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tSplit, iRow%, sCol$
'
If Target.Count > 1 Then Exit Sub
Cancel = True
'
If Target <> "" Then
    CreateObject("Wscript.shell").Popup "La case est déjà remplie!", 2, "Message" ' La case est déjà remplie
Else
    If Not Intersect(Target, Range("A2,A8,A14,A22,A28,A34,F2,F8,F14,F22,F28,F34")) Is Nothing Then
        iRow = Target.Row
        sCol = IIf(Time < 1 / 2, "A", "F")                  'choix de l'avant-midi ou après-midi
        Range(sCol & iRow).Font.Color = RGB(0, 0, 0)
        Range(sCol & iRow).Value = WorksheetFunction.Proper(Format(Now, "dddd d mmmm yyyy & h:mm:ss"))
        tSplit = Split(Range(sCol & iRow).Value, " ")       'affichage date avec lettres en rouge
        For y = 0 To 4 Step 2
            Range(sCol & iRow).Characters(InStr(Range(sCol & iRow).Value, tSplit(y)), 1).Font.Color = RGB(255, 0, 0)
        Next
        Range(sCol & iRow).Offset(1, 1).Select              'positionnement sur "Systolique - Mesure 1"
    End If
End If
'
End Sub

Pour afficher ou non ton graphique, c'est plus court ainsi...

ActiveSheet.ChartObjects("Graphique 1").Visible = IIf(ActiveSheet.ChartObjects("Graphique 1").Visible = True, False, True)

Pour effacer les données...

With Worksheets("Mesures")
    For x = 1 To 6
        iRow = Choose(x, 2, 8, 14, 22, 28, 34)
        Union(.Range("A" & iRow), .Range("F" & iRow), .Range("B" & iRow + 1 & ":D" & iRow + 3), .Range("G" & iRow + 1 & ":I" & iRow + 3)).Value = ""
    Next
End With

A+

Salut curulis57,

Bon hé bien ca fonctionne presque bien, juste ce code qui n'ai pas fiable (CreateObject("Wscript.shell").Popup "La case est déjà remplie!", 2, "Message")

un exemple j'ai rempli quelques lignes, date etc etc puis sans sortir d'excel, j'ai cliquer en haut sur l'icone "enregistrer", puis j'ai continuer et provoquer des

erreurs voir si cela fonctionne, la première erreur s'est bine afficher puis s'efface seule, donc bien ok

J'ai recommencer un peu plus tard même manipulation affichage de l'erreur et là j'ai attendu le message ne s'efface plus

j'ai suis sorti du programme, puis l'ai relancer même manipulation déjà expliquer ci dessus et même soucis

Cette façon de faire n'ai pas fiable ou alors ???

Alors j'ai penser a une autre façon de faire, me servir de la souris pour tester si la cellule ou je suis positionner est libre alors je peux double cliquer pour écrire la date et heure "A2,A8,A14,A22,A28,A34,F2,F8,F14,F22,F28,F34" sinon la cellule est occuper par une date/heure j'envoi un message "cellule déjà occuper" et dès que la souris n'ai plus sur une des cellules, le message s'efface, mais je peux toujours effacer manuellement la dite cellule et écrire une date.

Voila qu'en pense tu svp

bonne fin d'après midi a toi

Cdlt Ray

Salut Ray,

j'ai un peu modifié la Sub Worksheet_BeforeDoubleClick()... pas pensé avant... déso...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tSplit, iRow%, sCol$
'
If Target.Count > 1 Then Exit Sub
Cancel = True
'
If Not Intersect(Target, Range("A2,A8,A14,A22,A28,A34,F2,F8,F14,F22,F28,F34")) Is Nothing Then
    If Target <> "" Then
        CreateObject("Wscript.shell").Popup "La case est déjà remplie!", 2, "Message" ' La case est déjà remplie
    Else
        iRow = Target.Row
        sCol = IIf(Time < 1 / 2, "A", "F")                  'choix de l'avant-midi ou après-midi
        Range(sCol & iRow).Font.Color = RGB(0, 0, 0)
        Range(sCol & iRow).Value = WorksheetFunction.Proper(Format(Now, "dddd d mmmm yyyy & h:mm:ss"))
        tSplit = Split(Range(sCol & iRow).Value, " ")       'affichage date avec lettres en rouge
        For y = 0 To 4 Step 2
            Range(sCol & iRow).Characters(InStr(Range(sCol & iRow).Value, tSplit(y)), 1).Font.Color = RGB(255, 0, 0)
        Next
        Range(sCol & iRow).Offset(1, 1).Select              'positionnement sur "Systolique - Mesure 1"
    End If
End If
'
End Sub

Ici, pas de souci...

A+

Salut curulis57,

Merci pour la modification, bon le programme fonctionne très bien pour ça merci beaucoup

J'ai remplacer le code que tu a modifier puis mis en remarque l'ancien le tout sans sauvegarder.

j'ai commencer a me servir du programme et ok pas de soucis

j'ai provoquer une erreur sur la date le message s'est bien afficher mais n'a jamais voulu s'effacer seul

Donc du coup, j'ai sauvegarder avec le nouveau code, puis refait la même manipulation et la affichage

du message et puis effacement 2 secondes après.

Je reste convaincu que ce code ci dessous est pourri et pas fiable un coup dans le zig un coup dans le zag

CreateObject("Wscript.shell").Popup "La case est déjà remplie!", 2, "Message"

A part ca que pense tu de mon idée avec la souris ???

Bonne soirée a toi et merci

Cdlt Ray

Salut Ray,

comment fais-tu cela

j'ai provoquer une erreur sur la date

Salut curulis57,

Merci pour ta réponse,

Pour provoquer l'erreur, j'ai utiliser le programme comme prévu,

Ex: Que je viens de faire, j'ai mis la date (Samedi 2 Avril 2022 & 7h45)

j'ai pris mes 3 tensions et reporter dans le tableau.

Et volontairement, j'ai cliquer la cellule de la date et le message est apparu et c'est effacer au bout de 2 secondes.

Puis j'ai recommencer l'opération et cette fois le message est apparu mais ne c'est pas éteinds tout seul.

c'est pourquoi je dis que c'est fiable, cela fonctionne bien 2 ou 3 fois de suite puis ne fonctionne plus sans aucune raison apparente.

D'où l'idée d'utiliser la souris comme expliquer dans mon précédent message et donc svp quand pense tu ???

Bon W-end a toi et merci.

Cdlt Ray

Salut Ray,

ici, ça fonctionne même après avoir double-cliqué 20 X... ce qui ne m'étonne pas : une instruction fait toujours la même chose !!

Ce que j'en pense ?
Facile : tu (enfin, je ) fais un traitement automatique qui te permet, même en double-cliquant N'IMPORTE OÙ dans le tableau, d'afficher (ou pas) la date à sa bonne place si la cellule est vide
Et tu te passes de cette instruction Popup : qui est le saboteur qui a besoin de ce message pour savoir que la cellule contient déjà l'info ?

A+

Salut Ray,

première "nouvelle" version.
Tu peux double-cliquer n'importe où dans le jour souhaité (limitation actuelle) : la macro détermine la bonne cellule à compléter.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tSplit, iRow%, iTRow%, sCol$
'
If Target.Count > 1 Then Exit Sub
Cancel = True
'
iRow = Target.Row
sCol = IIf(Time < 1 / 2, "A", "F")                  'choix de l'avant-midi ou après-midi
iTRow = Range(sCol & "1:" & sCol & iRow).Find(what:="Jour", lookat:=xlPart, LookIn:=xlValues, searchdirection:=xlPrevious).Row + 1
If Range(sCol & iTRow) = "" Then
    Range(sCol & iTRow).Font.Color = RGB(0, 0, 0)
    Range(sCol & iTRow).Value = WorksheetFunction.Proper(Format(Now, "dddd d mmmm yyyy & h:mm:ss"))
    tSplit = Split(Range(sCol & iTRow).Value, " ")       'affichage date avec lettres en rouge
    For y = 0 To 4 Step 2
        Range(sCol & iTRow).Characters(InStr(Range(sCol & iTRow).Value, tSplit(y)), 1).Font.Color = RGB(255, 0, 0)
    Next
    Range(sCol & iTRow).Offset(1, 1).Select              'positionnement sur "Systolique - Mesure 1"
End If
'
End Sub

Je reviens tout à l'heure : là, je dois partir...

A+

Salut Ray,

quelques questions, après avoir rempli plusieurs tableaux de données :
- les trois tableaux "inférieurs" de prise de données ne devraient-ils pas s'identifier en Jour 4, Jour 5, Jour 6 ?
- les intitulés de ton graphique ne devraient-ils pas suivre les jours 1,2,... plutôt que les périodes (matin, soir) ?

A+

Re curulis57,

Merci pour le retour du fichier modifier, Donc la tous fonctionne bien, merci.

Tu me dit:

Première "nouvelle" version.
--- Tu peux double-cliquer n'importe où dans le jour souhaité (limitation actuelle)

Tu voie quelque chose a ajouter ou modifier que je n'aurais pas vu ???

Je n'arrive pas a modifier les libellés en bas du graphique et les chiffres de la colonne de 50 a 150 en jaune

je vais sur le site voir si je trouve quelque chose sur le sujet et par la même occasion comment ca fonctionne.

bonne fin d'après midi a toi et merci

Cdlt Ray

Salut Ray,

en ajoutant ceci, tu peux, réellement, double-cliquer n'importe où dans ta feuille pour que la date vienne s'afficher là où il faut si la cellule-date est vide

    For x = iTRow To 1 Step -1
        If InStr(Range(sCol & x).Value, "Jour") > 0 And Range(sCol & x + 1).Value = "" Then iTRow = x + 1
    Next

J'ai changé les légendes en Jour 4, 5, 6, y compris sur ton graphique.

Quels nombres veux-tu en vertical sur ton graphique (ceux en jaune) ?

A+

Re curulis57,

C'est presque bon, merci et c'est bien comme ça.

Les changements que tu a effectués me vont très bien, tu a de bonnes idées

je te renvoi le fichier car j'ai vu deux trucs qui vont pas, regarde svp j'ai mis une bulle.

Bonne soirée a toi, un plaisir de bosser avec toi.

Cdlt Ray

Re Curulis57,

J'ai omis de te répondre sur ta question ci-dessous

--- Quels nombres veux-tu en vertical sur ton graphique (ceux en jaune) ?

Je ne sais pas, je ne connais pas les valeurs minis et maxis a utiliser, je demanderai

a mon médecin et je changerai, si utile, on verra bien.

bonne soirée et merci a toi

Cdlt Ray

Salut Ray,

déso pour la légende du graphique sans le petit carré et l'absence de la dernière donnée : je n'avais pas remarqué et je ne sais pas comment réparer cela, étant (très) peu compétent dans ce domaine.

Va falloir espérer qu'un crack en graphique s'en mêle!

A+

Salut curulis57,

Merci pour ta réponse,

Bon tant pis ce n'ai pas grave, j'ai regarder sur le site mais je n'ai pas trouver pour ajout une valeur ou un libellé.

Mais je suis arrivé a la table des données, (je ne sais pas si c'est ça)

1) sélection du graphique > Révision > Affichage > Création > Disposition > Table des données j'ai cliquer sur le petit repère en bas a droite

et ca m'a afficher les données du bas du graphique, mais je n'ai réussi a modifier

Voila peut être que tu sauras, dommage caller si près du pot de sangria

Bon dimanche a toi

Cdlt Ray

Salut curulis57,

Pas réussi encore a modifier ou refaire le graphique, passer l'après midi dessus

on va voir si la nuit porte conseil, je crois que refaire le graphique sera plus sur

Bonne soirée a toi et merci pour ton aide.

c'est l'heure de la sangria

oups oublier doc sur les graphiques

Cdlt Ray