Message d'alerte pour Excel sur Windows

Version imprimable

Bonjour à tous,

J’ai écrit une petite procédure qui affiche un MSGBOX à l’utilisateur d’un fichier de control. Je souhaiterai que le message ne s’affiche pas seulement à l’ouverture du fichier, mais aussi quand le fichier n'est pas ouvert. Par exemple, à lancement de Windows et à des heures spécifiques. De sorte à rappeler l'utilisateur du statut de sont travail.

Je pense que c'est une ligne de code API.

Merci d’avance pour votre aide.

Ci-dessous la procédure que j’ai écrite pour afficher un msgbox, à l’ouverture du fichier et periodiquement; mais aussi sur clic d’un bouton que j’ai placé sur la feuille.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Option Explicit
Private O As Object 'déclare la variable O (Onglet)
Private DL As Integer 'déclare la variable DL (Dernière Ligne)
Private PL As Range 'déclare la variable PL (PLage)
Dim Lheure As Double
Dim Interval As Integer
 
Public Sub ArretTimer()      'Pour arrêter le timer, il suffit d'appeler cette procédure.
On Error Resume Next
      Application.OnTime Lheure, "ExecutionTimer", , False
End Sub
 
Public Sub ExecutionTimer()
      'Pour cette exemple, le code est exécuté  toutes les minutes.
      MonCountIf2
      Lheure = Now + TimeSerial(0, 1, 0)
      Application.OnTime Lheure, "ExecutionTimer"
End Sub
 
Sub MonCountIf2()
'
Set O = Sheets(1) 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 10).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 10 (=J) de l'onglet O(=Sheet1)
Set PL = O.Range("AA7:A" & DL) 'définit la palge PL
 
    Application.ScreenUpdating = False
    On Error Resume Next    'Comme le fichier est nouveau, au cas où il n'y a pas toutes les conditions du filtre, ne pas générer d'erreur à cause de ça.
 
        MsgBox Application.UserName & "," & vbCr & vbCr & Chr(149) & "There is " & WorksheetFunction.CountIf(PL, "Overdue") & _
        " Overdue : Prazo de pagament jà passou!" & vbCr & Chr(149) & "There is " & WorksheetFunction.CountIf(PL, "Due") & _
        " Due : Por pagar hoje!" & vbCr & Chr(149) & "There is " & WorksheetFunction.CountIf(PL, "Will be due") & _
        " Will Due : Por pagar esta semana" & vbCr & vbCr & Chr(149) & "There is " & WorksheetFunction.CountIf(PL, "Paid") & _
        " Paid : Pagamento já feito", vbInformation, _
        "Contas a pagar."
 
    Application.ScreenUpdating = True
End Sub

22/07/2017, 22h35
clementmarcotte

Bonjour,

Oui mais si ton fichier n'est pas ouvert, il ne peut pas lancer de macro.

Tu peux regarder du côté d'une tâche planifiée pour lancer Excel et ouvrir ton fichier. Ou bien un script VBS lancé avec une tâche planifiée...
22/07/2017, 22h47
RastaBomboclat

Merci clementmarcotte,

Je vais encore attendre quelques autres contributions. S'il n'y a toujours rien dans le sens que je souhaite, je vais utiliser le code qui envoie un email (MS Outlook), puisque tous les collègues ont toujours leur Outlook ouvert.

Merci encore.
23/07/2017, 11h24
patricktoulon

re

Bonjour
tu va attendre longtemps comme te l'a dit clément, si le fichier n'est pas ouvert nada queudale

c'est une tache planifié qu'il te faut qui peut se programmer via VBA mais c'est assez complexe il y a deux façon (deux object) en vba pour ca + les api mais pas toutes les configs les accepte

autant dire travailler en vbs tout dépends de ce que tu veux afficher dans ton message (d'où vient ce qui sera écrit)

j'ai retrouver l'exemple que j'ais pecho sur la toile et que j'avais traduis en Français

voila comment on programme une tache planifiée en vba avec l'object shredule service en late binding

cet exemple démarre Notepad dans 30 secondes même le fichier Excel fermé
tu pourrais te baser sur ce model pour programmer test taches

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
'------------------------------------------------------------------
' cet exemple te montre comment programmer une tache planifiée avec l'object "Schedule.Service" en late binding
'À partir du moment où la tâche est enregistrée.
'------------------------------------------------------------------
Sub TEST_SHREDULER()
 
'constante qui spécifie un déclencheur basé sur le temps.
Const TriggerTypeTime = 1
' constante qui spécifie une action exécutable
.Const ActionTypeExec = 0
 
'********************************************************
'Céation  l'objet TaskService
.Set service = CreateObject("Schedule.Service")
Call service.Connect' connection au shedule service
'********************************************************
'obtention d' un dossier pour créer une définition de tâche dans.
Dim rootFolder
Set rootFolder = service.GetFolder("\")
'La variable taskDefinition est l'objet TaskDefinition.
Dim taskDefinition
'Le paramètre flags est 0 car il n'est pas pris en charge.
Set taskDefinition = service.NewTask(0)' cr'ation de la nouvelle tache dans le sheduler 
'********************************************************
'Définir des informations sur la tâche.
'Définissez les informations d'inscription pour la tâche par
'Création de l'objet RegistrationInfo.
Dim regInfo
Set regInfo = taskDefinition.RegistrationInfo
 
regInfo.Description = "demarrer le bloc-notes à un certain moment"
 
regInfo.Author = "Patrick"
'********************************************************
'Définir le principal de la tâche
Dim principal
Set principal = taskDefinition.principal
'Définissez le type de connexion à la connexion interactive
principal.LogonType = 3
 
' Définissez l'information de réglage de la tâche pour le planificateur de tâches par
'Création d'un objet TaskSettings.
Dim settings
Set settings = taskDefinition.settings
settings.Enabled = True
settings.StartWhenAvailable = True
settings.Hidden = False
'********************************************************
' Créez un déclencheur basé sur le temps.
Dim triggers
Set triggers = taskDefinition.triggers
Dim trigger
Set trigger = triggers.Create(TriggerTypeTime)
' les variables qui définissent quand le déclencheur est actif.
Dim startTime, endTime
'exemple
Dim time
time = DateAdd("s", 30, Now)  'start time = 30 secondes a partir de maintenant
startTime = XmlTime(time)
'selon les disponibilité du PC la tache demarrera entre ces deux moments
time = DateAdd("s", 60, Now) 'end time = 60 secondes a partir de maintenant
endTime = XmlTime(time)
MsgBox "startTime :" & startTime
MsgBox "endTime :" & endTime
trigger.StartBoundary = startTime
trigger.EndBoundary = endTime
trigger.ExecutionTimeLimit = "PT5M"    '5 minutes de delay
trigger.ID = "TimeTriggerId"
trigger.Enabled = True
'***********************************************************
' Création  l'action pour la tâche à exécuter.
' Ajoutez une action à la tâche pour exécuter notepad.exe.
Dim Action
Set Action = taskDefinition.Actions.Create(ActionTypeExec)
Action.Path = "C:\Windows\System32\notepad.exe"
MsgBox "Création de la définition de la tâche. À propos de soumettre la tâche ..."
'***********************************************************
'Enregistrez (créer) la tâche.
Call rootFolder.RegisterTaskDefinition( _
    "Test TimeTrigger", taskDefinition, 6, , , 3)
MsgBox "Tâche soumise."
End Sub
 
'------------------------------------------------------------------
'la fonction qui suit sert a mettre le format date heure minutes secondes au format pour le shreduler
' Utilisé pour obtenir le temps pour le déclencheur
' startBoundary and endBoundary.la fonction sera utilisé deux fois pour le starttimeet endtime
' Renvoie l'heure dans le format correct:
' exemple :YYYY-MM-DDTHH:MM:SS.
'------------------------------------------------------------------
Function XmlTime(t)
    Dim cSecond, cMinute, CHour, cDay, cMonth, cYear, tTime, tDate
        cSecond = "0" & Second(t)
    cMinute = "0" & Minute(t)
    CHour = "0" & Hour(t)
    cDay = "0" & Day(t)
    cMonth = "0" & Month(t)
    cYear = Year(t)
    tTime = Right(CHour, 2) & ":" & Right(cMinute, 2) & ":" & Right(cSecond, 2)
    tDate = cYear & "-" & Right(cMonth, 2) & "-" & Right(cDay, 2)
    XmlTime = tDate & "T" & tTime
End Function

voila les commentaires sont suffisamment clair tu devrais pas trop avoir de mal a t'en sortir
;)

24/07/2017, 01h35
RastaBomboclat

Merci patricktoulon,

Je n'avais pas vu ton message. Au fait le message viendrai du résultat d'une fonction calculé avec les données de la "Sheet1".

En gros, Il y a une feuille avec sur la colonne B, les noms des utilisateurs et sur la colonne G le statut (EnCours et EnRetard). Je veux faire un Worksheetfunction.Countifs(NomUtilisateur,"EnCours",NomUtilisateur1,"EnRetard",NomUtilisateur2,"EnCours",NomUtilisateur2,"EnRetard",... etc).
L'alerte qui s'affichera donnera la reponse de la fonction ci-haut.

C'est ca que je veut faire.
J'ai reussi à le faire en partie, mais je reussire completement. J'ai dit en partie parce que ça marche avec COUNTIF et non avec COUNTIFS. Je n'arrive pas à faire fontionner le Countifs qui fera le compte de chaque utilisateurs (il y en a 7) par statut (EnCours et EnRetard).
24/07/2017, 01h38
RastaBomboclat

Waou patricktoulon,
Ton code c'est du costaud. J'entre dans la cours des grands.
Merci pour ce code. Je m'y mets et verai ce que ça donnera.

A très bientôt.

Bonjour,

Concernant le message à afficher, je n'ai pas pu faire fonctionner la fontion "COUNTIFS", alors je suis passé par une autre voie. Vous le trouverez ci-dessous.
Pouvez-vous m'aider à le rendre plus concis?

Merci.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Option Explicit
Private P As Object 'déclare la variable P (Page)
 
Sub MonMsgbox()
Dim a1 As Integer: Dim a2 As Integer: Dim a3 As Integer: Dim a4 As Integer: Dim a5 As Integer: Dim a6 As Integer: Dim a7 As Integer
Dim b1 As Integer: Dim b2 As Integer: Dim b3 As Integer: Dim b4 As Integer: Dim b5 As Integer: Dim b6 As Integer: Dim b7 As Integer
Set P = Sheets(3) 'définit la Page P
 
 a1 = P.Range("B2").Value: a2 = P.Range("B3"): a3 = P.Range("B4"): a4 = P.Range("B5"): a5 = P.Range("B6"): a6 = P.Range("B7"): a7 = P.Range("B8")
 b1 = P.Range("C2").Value: b2 = P.Range("C3"): b3 = P.Range("C4"): b4 = P.Range("C5"): b5 = P.Range("C6"): b6 = P.Range("C7"): b7 = P.Range("C8")
 
MsgBox Application.UserName & " there is for:" & vbCr & vbCr & Chr(149) & _
"Mateus " & a1 & " Atrasado; e " & b2 & " No prazo" & vbCr & Chr(149) & _
"Marcos" & a2 & " Atrasado; e " & b2 & " No prazo" & vbCr & Chr(149) & _
"Lucas" & a3 & " Atrasado; e " & b3 & " No prazo" & vbCr & Chr(149) & _
"Joao" & a4 & " Atrasado; e " & b4 & " No prazo" & vbCr & Chr(149) & _
"Paolo" & a5 & " Atrasado; e " & b5 & " No prazo" & vbCr & Chr(149) & _
"Pedro" & a6 & " Atrasado; e " & b6 & " No prazo" & vbCr & Chr(149) & _
"Tiago" & a7 & " Atrasado; e " & b7 & " No prazo", vbInformation, "Internal Control     LOG - Plano de Trabalho"
 
Set P = Nothing
End Sub

je vois pas trop quoi simplifier a patr l'écriture comme suit peut être
Option Explicit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub MonMsgbox()
    Dim a, b
    With Sheets(3)
        a = Array("", .Range("B2").Value, .Range("B3"), .Range("B4"), .Range("B5"), .Range("B6"), .Range("B7"), .Range("B8"))
        b = Array("", .Range("C2").Value, .Range("C3"), .Range("C4"), .Range("C5"), .Range("C6"), .Range("C7"), .Range("C8"))
    End With
    MsgBox Application.UserName & " there is for:" & vbCr & vbCr & Chr(149) & _
           "Mateus " & a(1) & " Atrasado; e " & b(2) & " No prazo" & vbCr & Chr(149) & _
           "Marcos" & a(2) & " Atrasado; e " & b(2) & " No prazo" & vbCr & Chr(149) & _
           "Lucas" & a(3) & " Atrasado; e " & b(3) & " No prazo" & vbCr & Chr(149) & _
           "Joao" & a(4) & " Atrasado; e " & b(4) & " No prazo" & vbCr & Chr(149) & _
           "Paolo" & a(5) & " Atrasado; e " & b(5) & " No prazo" & vbCr & Chr(149) & _
           "Pedro" & a(6) & " Atrasado; e " & b(6) & " No prazo" & vbCr & Chr(149) & _
           "Tiago" & a(7) & " Atrasado; e " & b(7) & " No prazo", vbInformation, "Internal Control     LOG - Plano de Trabalho"
End Sub

on pourrait simplifier encore mais je n'en vois pas l'intérêt