Agenda électronique sur Excel

[CHRIS 57]

Bonjour à tous,

j'ai réalisé un agenda électronique sur excel qui permet d'enregistrer des mémos à tel et tel date et heure.


A l'ouverture du classeur, il vérifie automatiquement s'il y a un mémo qui concerne les 3 prochains jours.
Si c'est le cas, une fenêtre s'ouvre et informe l'utilisateur qu'un rendez-vous est enregistré pour aujourd'hui, demain ou après demain.


Sinon j'ai aussi réalisé (avac l'aide de ce forum), une tempo qui s'active également à l'ouverture du classeur uniquement s'il n'y a pas de mémo pour les 3 prochains jours : dans ce cas, au bout de 10 sec, le classeur se ferme.


J'ai ensuite planifié l'ouverture de ce classeur chaque jour, mais lorsqu'il s'ouvre à l'heure planifée, le message indiquant le rendez-vous s'affiche, mais lorsque je le valide, le programme se bloque !

Le fichier étant trop gros, voici la macro qui s'active à l'ouverture :

-----------------------------------------------------------------------------------------------

Private Sub Workbook_Open()
'A L'OUVERTURE lance la vérification si RENDEZ-VOUS AUJOURD'HUI / DEMAIN / APRES-DEMAIN
Application.WindowState = xlMaximized
VERIFsiRDV
End Sub

Option Explicit
-----------------------------------------------------------------------------------------------
Sub VERIFsiRDV()
Application.ScreenUpdating = False

' VERIFICATION SI RENDEZ-VOUS AUJOURD'HUI / DEMAIN / APRES-DEMAIN
MESSAGE = 0
[R3] = Date
[S3] = Date + 1
[T3] = Date + 2
[R3].NumberFormat = "dddd d mmm yyyy"
[S3].NumberFormat = "dddd d mmm yyyy"
[T3].NumberFormat = "dddd d mmm yyyy"

' Vérifie si il y a un rendez-vous aujourd'hui
For Each X In [B4:B3000]
If X.Text = [R3].Text Then
MESSAGE = 1
X.Offset(0, 2).Select
Msg1 = " Vous avez un mémo pour aujourd'hui : "
DATEheure = " " & X.Text & " à " & X.Offset(0, 2).Text
TEXTE1 = X.Offset(0, 3).Text
Msg = Msg1 & Chr(13) & Chr(13) & DATEheure & Chr(13) & Chr(13) & Chr(13) & TEXTE1 & Chr(13) & Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Msg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then X.Resize(1, 4).ClearContents
End If
Next X

' Vérifie si il y a un rendez-vous demain
For Each Y In [B4:B3000]
If Y.Text = [S3].Text Then
MESSAGE = 1
Y.Offset(0, 2).Select
Msg2 = " Vous avez un mémo pour demain : "
DATEheure2 = " " & Y.Text & " à " & Y.Offset(0, 2).Text
TEXTE2 = Y.Offset(0, 3).Text
Msg = Msg2 & Chr(13) & Chr(13) & DATEheure2 & Chr(13) & Chr(13) & Chr(13) & TEXTE2 & Chr(13) & Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Msg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then Y.Resize(1, 4).ClearContents

End If
Next Y

' Vérifie si il y a un rendez-vous demain
For Each Z In [B4:B3000]
If Z.Text = [T3].Text Then
MESSAGE = 1
Z.Offset(0, 2).Select
Msg3 = " Vous avez un mémo pour après-demain : "
DATEheure3 = " " & Z.Text & " à " & Z.Offset(0, 2).Text
TEXTE3 = Z.Offset(0, 3).Text
Msg = Msg3 & Chr(13) & Chr(13) & DATEheure3 & Chr(13) & Chr(13) & Chr(13) & TEXTE3 & Chr(13) & Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Msg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then Z.Resize(1, 4).ClearContents

End If
Next Z

TRIER

' Se positionne sur la date du jour
For Each X In [B4:B3000]
If X.Text = [R3].Text Then
X.Offset(0, 2).Select
End If
Next X

' Si pas de message alors lance la tempo pour la fermeture
If MESSAGE = 0 Then LANCEURchrono

End Sub

-----------------------------------------------------------------------------------------------
(les variables sont définies à part) :

Public DATEaujour As Date
Public DATErdv As Date
Public MESSAGE ' Si message
Public TEMPO As Date ' Variable qui arrête la tempo à l'ouverture

Public Msg, Response
Public X, Msg1, TEXTE1, DATEheure
Public Y, Msg2, TEXTE2, DATEheure2
Public Z, Msg3, TEXTE3, DATEheure3


-----------------------------------------------------------------------------------------------


Là j'avoue ne rien y comprendre...

 

[tatiak]

Bonsoir,
A vue de nez il faut pas oublier de remetre Application.screenupdating =true à la fin de la procédure.
Sinon, il est possible de simplifier un peu le code de la manière suivante (sauf erreur?):
-----------------------------------------------------------------------------------------------
(les variables sont définies à part) :

Public DATEaujour As Date
Public DATErdv As Date
Public TEMPO As Date ' Variable qui arrête la tempo à l'ouverture

Public Msg, Response, TEXTE, Dateheure as String
Public X as Range
-----------------------------------------------------------------------------------------------

Sub VERIFsiRDV()
' VERIFICATION SI RENDEZ-VOUS AUJOURD'HUI / DEMAIN / APRES-DEMAIN
Application.ScreenUpdating = False


’MESSAGE = false
Msg=""

' Vérifie si il y a un rendez-vous aujourd'hui/demain/après-demain
For Each X In [B4:B3000]
If X.value = date Then Msg = " Vous avez un mémo pour aujourd'hui : "
If X.value = date + 1 Then Msg = " Vous avez un mémo pour demain : "
If X.value = date + 2 Then Msg = " Vous avez un mémo pour après-demain : "
If Msg<>"" then
X.Offset(0, 2).Select
DATEheure = " " & X.Text & " à " & X.Offset(0, 2).Text
TEXTE = X.Offset(0, 3).Text
Msg = Msg & Chr(13) & Chr(13) & DATEheure & Chr(13) & Chr(13) & Chr(13) & TEXTE & Chr(13) & _
Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Msg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then X.Resize(1, 4).ClearContents
End If
Next X

TRIER

' Se positionne sur la date du jour
For Each X In [B4:B3000]
If X.value = Date Then X.Offset(0, 2).Select
Next X

' Si pas de message alors lance la tempo pour la fermeture
If Msg="" Then LANCEURchrono

Application.ScreenUpdating = True
End Sub

 

[tatiak]

Oups, il faut bien sur supprimer la ligne :
’MESSAGE = false

 

[tatiak]

A la relecture, la version suivante doit être meilleure!:

Sub VERIFsiRDV()
Dim msg(3) as string
Dim i as byte

Application.ScreenUpdating = False
Msg=""
msg(1)=" Vous avez un mémo pour aujourd'hui : "
msg(2)=" Vous avez un mémo pour demain : "
msg(3)=" Vous avez un mémo pour après-demain : "

' Vérifie si il y a un rendez-vous aujourd'hui/demain/après-demain
For i = 1 to 3
For Each X In [B4:B3000]
If X.value = date + i - 1 Then Msg = msg(i)
If Msg<>"" then
X.Offset(0, 2).Select
DATEheure = " " & X.Text & " à " & X.Offset(0, 2).Text
TEXTE = X.Offset(0, 3).Text
Msg = Msg & Chr(13) & Chr(13) & DATEheure & Chr(13) & Chr(13) & Chr(13) & TEXTE & Chr(13) & _
Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Msg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then X.Resize(1, 4).ClearContents
End If
Next X
Next i

TRIER

For Each X In [B4:B3000]
If X.value = Date Then X.Offset(0, 2).Select
Next X

If Msg="" Then LANCEURchrono

Application.ScreenUpdating = True
End Sub

 

[CHRIS 57]

Effectivement le "Application.ScreenUpdating = True" est nécessaire dans ce cas. Je ne l'ai plus mis depuis que j'ai lue quelque part qu'il n'était plus necessaire dans les dernières versions de Excel (j'ai la version XP)


Sinon merci pour avoir passé autant de temps sur mon pb. Ta macro est bien plus simple, mais lorsque je la lance, il subsiste un message d'erreur :
à la ligne Msg="" j'ai le message "Impossible d'affecter à un tableau" .


Encore une chose : je maîtrise mal les boucles du genre "For i = 1 to 3". Cela signifie que i va prendre respectivement les valeurs 1 puis 2 puis 3 ?

Et pourquoi la lettre i ? Peut-on utiliser une autre variable ?


Merci encore !!!!!!!

 

[tatiak]

Bonsoir Chris57,

Effectivement, j'ai commis qq erreurs, en voulant aller trop vite!
Cette version fonctionne bien mieux!
(il y avait une confusion entre la variable Msg et le tableau Msg(3) et la déclaration Msg="" était au mauvais endroit et donc générait une boucle sans fin)

Pour la boucle for, tes intuitions sont les bonnes, et on peut tout à fait nommer "i" comme on veut (mais i, j ou k sont classiquement utilisés par convention en programmation pour les variables locales de boucle n'ayant pas besoin de nom plus explicite)

'----------------------------------------
Public DATEaujour As Date
Public DATErdv As Date
Public TEMPO As Date ' Variable qui arrête la tempo à l'ouverture

Public Mesg, Response, TEXTE, Dateheure As String
Public X As Range
'----------------------------------------

Sub VERIFsiRDV()
Dim Msg(3) As String
Dim i As Byte

Application.ScreenUpdating = False
Msg(1) = " Vous avez un mémo pour aujourd'hui : "
Msg(2) = " Vous avez un mémo pour demain : "
Msg(3) = " Vous avez un mémo pour après-demain : "

For i = 1 To 3
For Each X In [B4:B3000]
Mesg = ""
If X.Value = Date + i - 1 Then Mesg = Msg(i)
If Mesg <> "" Then
X.Offset(0, 2).Select
Dateheure = " " & X.Text & " à " & X.Offset(0, 2).Text
TEXTE = X.Offset(0, 3).Text
Mesg = Mesg & Chr(13) & Chr(13) & Dateheure & Chr(13) & Chr(13) & Chr(13) & TEXTE & Chr(13) & _
Chr(13) & Chr(13) & Chr(13) & " Supprimer ce mémo ?"
Response = MsgBox(Mesg, vbYesNo + vbCritical, "MEMO")
If Response = vbYes Then X.Resize(1, 4).ClearContents
End If
Next X
Next i
TRIER
For Each X In [B4:B3000]
If X.Value = Date Then X.Offset(0, 2).Select
Next X
If Mesg = "" Then LANCEURchrono
Application.ScreenUpdating = True
End Sub

 

[CHRIS 57]

C'est parfait !

Merci encore !!!