Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

[matthieu2701]

Bonjour,

J'ai une macro que génère l'envoi d'un mail. J'aimerais, que lorsque l'on clique sur le bouton qui est affecté à ma macro "Envoyer le mail", la date et l'heure d'envoi se note dans une cellule.

Merci par avance de votre aide.

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Bonjour à Tous, Matthieu2701
Lorsque que tu transmets un fichier en PJ.
Pourrais-tu avertir s'il y a un auto OPEN

Private Sub Workbook_Open()
Dim a As String

'With Sheets("EchŽancier")
    'NNI = .Range("G14")
'End With

If Sheets("EchŽancier").Range("G14") = "" Then
a = InputBox("Merci de saisir votre NNI", "Saisie")
Sheets("EchŽancier").Range("G14") = a
ActiveWorkbook.Save
Else
Exit Sub
End If
End Sub

Voilà ce que ça donne chez moi et cela me plante Excel.

Je regarde ce soir.
A+

Tu as pu regarder ?

Merci

 

[Regueiro]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Bonsoir ä Tous, Matthieu2701.
Pourrais-tu mettre le code pour l'envoie de ton mail.
Ainsi que les variables Nd et Ob selon Post N 11 de Si...
merci
A+

 

[Regueiro]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Bonjour à tous, Matthieu2701
Comme indiquer sur mon Post Précédent, je veux bien regarder.
Mais pourrais-tu mettre ici ton code.
Merci.
A.

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Bonjour à tous, Matthieu2701
Comme indiquer sur mon Post Précédent, je veux bien regarder.
Mais pourrais-tu mettre ici ton code.
Merci.
A.

Voilà le code pour l'envoi du mail

Public UserName As String 
Public MailDbName As String 
Public BaseMail As Object 
Public Session As Object 'The notes session 
Public NomUtilisateur As String 
Public BaseMail_Serveur As String 
Public BaseMail_Fichier As String 
'Public ListeDoc As NotesDocumentCollection 
'Dim PieceJointe As Object 
Public Objet As Object 
Public Destinataires(5) As String 
Public ccDestinataires(5) As String 
Public cccDestinataires(3) As String 
Public Subject As String 
Public LeMail As Object 
Public Sujet 
Public rtstyle 
Public rtstyle2 
Public colorObject 


Public Sub SendNotesMail() 
        
Set Session = CreateObject("Notes.NotesSession") 
'Ouvre la base des mails 
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf" 
UserName = Session.UserName 
'Ouvre la base des mails 
Set BaseMail = Session.GetDataBase("", "") 
If Not BaseMail.IsOpen Then BaseMail.OpenMail 

End Sub 
Public Sub Fin_Notes_Envoi() 
'LIBERE LES OBJETS 
Set BaseMail = Nothing 
Set LeMail = Nothing 
Set PieceJointe = Nothing 
Set Session = Nothing 
Set Objet = Nothing 
Exit Sub 
End Sub 
Public Sub Lancement_PacaOuest() 
Call RoutineEnvoiMailLotus_PacaOuest 
End Sub 

Public Sub RoutineEnvoiMailLotus_PacaOuest() 
 Application.ScreenUpdating = False 

'Perso, je préfère définir des noms sur les cellules plutot que d'utiliser B1, B2...
 With Sheets("Echéancier") 
     Ref = .Range("B1") 
     Nom = .Range("B2") 
     Adresse = .Range("B3") 
     Dette = .Range("D1") 
     PCE = .Range("G6") 
     Compteur = .Range("G7") 
     Matricule = .Range("G8") 
     Téléphone = .Range("G9") 
     CommentaireMail = .Range("G10") 
     CommentaireIgor = .Range("G11") 
     Centre = .Range("G5") 
     Champ1 = "N° de PCE------------------------ : " 
     Champ2 = "IGOR------------------------------- : " 
     Champ3 = "Nom du client----------------- : " 
     Champ4 = "Adresse de livraison------- : " 
     Champ5 = "Téléphone du client------- : " 
     Champ6 = "Compteur sur place------- : " 
     Champ7 = "         matricule : " 
     Champ8 = "Montant------------------------ : " 
     Champ9 = "Echéancier------------------- : " 
     Champ10 = "Commentaire--------------- : " 
 End With 
  
 With Sheets("Echéancier") 
 If Centre = 241 Or Centre = 242 Or Centre = 243 Or Centre = 245 Or Centre = 253 Or Centre = 254 Or Centre = 259 Then 
     MsgBox "Centre incorrect.", vbCritical, "Attention" 
     Exit Sub 
 End If 
 If PCE = "" Or Compteur = "Oui" And Matricule = "" Or Téléphone = "" Or CommentaireMail = "" Or Ref = "" Or Nom = "" Or Adresse = "" Or Dette = "" Then 
 MsgBox "Veuillez Remplir tous les champs avant d'envoyer le mail.", vbOKOnly + vbCritical, "Attention" 
 Exit Sub 
 Else 
  
'NNI des agents 
'Marignane 
Matthieu = "b90570" 
Yacine = "J03455" 
Sophie = "d41254" 
Maxence = "J33056" 
Remi = "f02756" 
Camille = "c60772" 
Cindy = "cm0d924n" 
Sarah = "ss0c0can" 
Priscilla = "d91472" 
Zoe = "F90572" 
Elodie = "d04673" 
Virginie = "VR023B1N" 
Daniel = "h86540" 
Nathalie = "b22929" 
Alexandre = "i62338" 
Stephane = "a06745" 
Florent = "C65470" 

'Nimes 
Fabienne = "f74844" 
Claudia = "j88653" 
Magali = "J37249" 

'Recherche de l'utilisateur qui a ouvert la session 
utilisateur = Environ("username") 
Select Case utilisateur 

Case Matthieu, Yacine, Sophie, Maxence, Remi, Camille, Cindy, Sarah, Priscilla, Zoe, Elodie, Virginie, Daniel, Nathalie, Alexandre, Stephane, Florent 
    chemin = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE 
    chemin2 = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\" 
    fichier = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours" & "\" & Nom & " " & PCE & "\" & Nom & " Engagement de Paiement.docx" 
Case Fabienne, Claudia, Magali 
   chemin = "Q:\AAG\DOSSIERS NUMERIQUES PDD" & "\" & Nom & " " & PCE 
   chemin2 = "Q:\AAG\DOSSIERS NUMERIQUES PDD\" 
   fichier = "Q:\AAG\DOSSIERS NUMERIQUES PDD" & "\" & Nom & " " & PCE & "\" & Nom & " Engagement de Paiement.docx" 

End Select 
  
If Dir(fichier, vbDirectory) = "" Then 
MsgBox "Le dossier numérique ou l'engagement de paiement de " & Nom & " " & PCE & " n'a pas été créé. Veuillez le créer puis recommencer", vbCritical, "Attention" 
Exit Sub 
End If 

'Application.DisplayAlerts = False '(utiliser aussi pour le sauvegarde) 
'ActiveWorkbook.SaveAs Filename:="C:\TEMP\" + NomFichier, FileFormat _ 
':=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _ 
'False, CreateBackup:=False 
'Application.DisplayAlerts = True 


'DEFINITION DES DONNEES POUR L'ENVOI DU MESSAGE 

'Gestionnaire Habilitation 
'tu peux ici déclarer tes variables pour les utiliser pour les destinataires, ou personnes en copie etc. 
'Destintaire2 = Sheets("Demande").Range("Destinatarie2").Value 
'AutreDestinaire = Sheets("Demande").Range("AutreDestinataire2").Value 

Sujet = "Rétablissement PDD" & " - " & "PCE " & PCE ' 

Destinataires(0) = "Toto@free.fr" 
'Destinataires(1) = "" 
'-------------------------------------------------------- 
'Personne en copie 
'ccDestinataires(0) = "" 
'ccDestinataires(1) = "" 
'-------------------------------------------------------- 
'-------------------------------------------------------- 
'Personne en copie cachée 
cccDestinataires(0) = "" 
'cccDestinataires(1) = AutreDestinaire 
'-------------------------------------------------------- 
fichier1 = Nom & " Engagement de Paiement.docx" ' "NomDuFichier.xls" 
If chemin > "" And Right(chemin, 1) <> "\" Then chemin = chemin & "\" 
FichierJoint = chemin & fichier1 
Fichier2 = "RIB GRDF.pdf" 
FichierJoint2 = chemin2 & Fichier2 

'RECUPERATION DE LA SESSION NOTES 
Call SendNotesMail 

'Si erreur dans le module Init_Notes alors on revient ici et on affiche le message sinon on continue 
If Retour = ERR_NOTES_ERROR Then 
MsgBox " Erreur lors de l'ouverture de la session ", vbExclamation, " Problème " 
Exit Sub 
End If 

' Création du message 
Set LeMail = BaseMail.CreateDocument

'Déclarations pour la mise en forme du texte (gras, italic...) 
Set rtstyle = Session.CreateRichTextStyle 
Set rtstyle2 = Session.CreateRichTextStyle 
Set colorObject = Session.CreateColorObject 

Call LeMail.AppendItemValue("Form", "Memo") 
Call LeMail.AppendItemValue("sendTo", Destinataires) 
Call LeMail.AppendItemValue("CopyTo", ccDestinataires) 
Call LeMail.AppendItemValue("BlindCopyTo", cccDestinataires) 
Call LeMail.AppendItemValue("Subject", Sujet) 

'LeMail.SaveMessageOnSend = True 
Set Body = LeMail.CreateRichTextItem("Body") 

'****************************************************************************** 
'Personnalisation du message envoyé 
rtstyle.Bold = True 
rtstyle.Italic = True 
rtstyle.NotesFont = 2 
rtstyle.FontSize = 10 
rtstyle2.Bold = False 
rtstyle2.Italic = False 
'****************************************************************************** 
'Message$ = "Bonjour," & vbCrLf & vbCrLf & "Je t 'envoie les informations concernant le rétablissement gaz suite PDD." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & _ 
'"1 - IDENTIFICATION DU CLIENT / DEMANDE" & _ 
'vbCrLf & vbCrLf & vbCrLf & vbCrLf & Champ1 & PCE & vbCrLf & vbCrLf & Champ2 & Ref & vbCrLf & vbCrLf & Champ3 & Nom & vbCrLf & vbCrLf & Champ4 & Adresse & vbCrLf & vbCrLf & Champ5 & _ 
'"0" & Téléphone & vbCrLf & vbCrLf & Champ6 & Compteur & "      " & Champ7 & Matricule & vbCrLf & vbCrLf & Champ8 & FormatNumber(Dette, 2) & vbCrLf & vbCrLf & Champ9 & _ 
'"Voir PiÃ_ce jointe" & vbCrLf & vbCrLf & Champ10 & Commentaire & vbCrLf & vbCrLf & "Cordialement" 'message 
' Fichier$ = Nom & " Engagement de Paiement.docx" ' "NomDuFichier.xls" 
' Chemin$ = "Q:\AAGP2\PDD GAZ\PDD\Dossiers PDD\En cours\" & "\" & Nom & " " & Ref ' chemin du fichier exp: = ThisWorkbook.Path 
' If Chemin$ > "" And Right(Chemin$, 1) <> "\" Then Chemin$ = Chemin$ & "\" 

Call Body.AppendText("Bonjour,") 
Call Body.AddNewLine(2) 
Call Body.AppendText("Je t 'envoie les informations concernant le rétablissement gaz suite PDD.") 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------") 
Call Body.AppendStyle(rtstyle2) 
Call Body.AddNewLine(1) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText("                          1 - IDENTIFICATION DU CLIENT / DEMANDE") 
Call Body.AppendStyle(rtstyle2) 
Call Body.AddNewLine(1) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------") 
Call Body.AppendStyle(rtstyle2) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ1) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(PCE) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ2) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Ref) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ3) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Nom) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ4) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Adresse) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ5) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Format(Téléphone, "0000000000")) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ6) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Compteur) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ7) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(Matricule) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ8) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(FormatNumber(Dette, 2)) 
Call Body.AppendText(" euros") 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ9) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText("Voir pièce jointe") 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(Champ10) 
Call Body.AppendStyle(rtstyle2) 
Call Body.AppendText(CommentaireIgor) 
Call Body.AddNewLine(2) 
Call Body.AppendText(CommentaireMail) 
Call Body.AddNewLine(2) 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText("------------------------------------------------------------------------------------------------------------------------------------") 
Call Body.AppendStyle(rtstyle2) 
Call Body.AddNewLine(2) 
Call Body.AppendText("Bonne Réception.") 
Call Body.AddNewLine(2) 
Call Body.AppendText("Cordialement") 
Call Body.AddNewLine(2) 
'tu ouvres avec ce style 
Call Body.AppendStyle(rtstyle) 
Call Body.AppendText(EmetteurA) 
'tu fermes avec ce style 
Call Body.AppendStyle(rtstyle2) 
Call Body.AddNewLine(2) 
LeMail.SaveMessageOnSend = True 

LeMail.SaveMessageOnSend = True 
'Prend en compte les pièces jointes 
If FichierJoint <> "" Then 
Set AttachME = LeMail.CreateRichTextItem("Attachment") 
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint, "Attachment") 
End If 
If Range("I7") = "virement" Then 
Set EmbedObj = AttachME.EmbedObject(1454, "", FichierJoint2, "Attachment") 
End If 

'Envoie le mail 
LeMail.Send 0 

'LIBERE LES OBJETS 
Call Fin_Notes_Envoi 

Erase Destinataires() 
Erase ccDestinataires() 
Erase cccDestinataires() 

ActiveSheet.Shapes("MonBouton4").Visible = True 
Application.OnTime Now + TimeValue("00:00:02"), "EffacerMessage4" 

End If 
End With 
End Sub 
Sub EffacerMessage4() 
ActiveSheet.Shapes("MonBouton4").Visible = False 
End Sub

Merci

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

@regueiro est ce que cela te vas ?

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Help me please.

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

J'ai réussi. Merci

 

[Regueiro]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Bonsoir Le Forum, Matthieu 2701.
Je ne suis malheureusement pas arrivé de mon côté.
Tant mieux pour toi.
Bonne continuation.
PS : si tu pouvais mettre ta trouvaille sur le Post, que tout le monde en profite
A+

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

Je posterais ça. Pas de soucis.

 

[matthieu2701]

Re : Noter, dans une cellule, l'heure et la date de l'éxécution d'une macro

J'ai noté ca pour l heure : Sheets("Feuil1").Range("A1").Value = Format(Now, "dddd dd mmmm yyyy / h:mm") et ca pour le nom Sheets("Feuil1").Range("A1").Value = session("username")