VBA -Différencier ouverture automatique & ouverture manuelle
Bonjour à la communauté,
Je reviens vers vous concernant un projet où un membre du forum m'avait déjà bien aidé (#Thev, encore merci à lui) mais j'ai un dernier petit soucis qui n'a rien à voir avec le premier donc nouveau Post !
Alors le fichier permettra à notre service comptable de savoir quelle chèque sont à encaisser.
Pour cela le fichier s'ouvre automatiquement à l'ouverture de la session et entame cette première macro :
Private Sub Workbook_Open()
Dim date_i As Range
For Each date_i In Feuil1.Columns("I").SpecialCells(xlCellTypeConstants)
If date_i.Value <= Date Then Call Mail
Next date_i
End Sub
Ainsi, si la condition est respectée, la macro Mail se lance :
Sub Mail()
Dim a As MailItem
Set a = Outlook.CreateItem(olMailItem)
With a
.To = "comptabilite.encaissement@xxx.xx"
.Subject = "Tableau des chèques à encaisser en différer"
.Attachments.Add ("N:\xxx)
.Body = "Bonjour," & vbLf & vbLf & "Je vous invite à trouver en fichier joint le tableau des chèques à encaisser en différé." & vbLf & vbLf & "Merci de bien vouloir en prendre connaissance pour visualiser les chèques à encaisser aujourdhui." & vbLf & vbLf & "Cordialement," & vbLf & vbLf
.Send
End With
End Sub
Maintenant, on passe à la question :
Est-il possible de rajouter une macro qui ferme le fichier si il a été ouvert automatiquement au démarrage de la session mais ne se ferme pas si on l'ouvre manuellement ?
Un grand merci d'avance pour vos réponses
Restant à votre disposition si mes explications ne sont pas clair !
Cordialement,
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Tout d'abord une petite correction à effectuer, compléter l'instruction
If date_i.Value <= Date Then Call Mail: Exit For
voir mon dernier post : https://forum.excel-pratique.com/excel/demarrer-une-macro-sous-une-condition-date-t94755.html
Ensuite pour votre question, une suggestion simple pour différencier les 2 méthodes d'ouverture du fichier :
1- ouverture automatique en lecture seule au démarrage de la session, auquel cas il est simple de programmer une fermeture,
2- ouverture normale en manuel.
Bonjour Thev,
En effet je n'avais pas vue votre dernier message sur le précèdent Post D: Merci pour ce petit plus ^^
Je n'ai pas trop compris l'idée que vous me présentiez, mais j'avais aussi pensé à quelque chose :
Mettre en place une macro "MsgBox" qui propose soit de :
1) Vérifier le fichier, dans ce cas les macros se lance et on rajoute une fermeture du fichier.
2) Modifier le fichier et dans se cas aucune macro se lance.
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Si au démarrage de la session, le classeur est ouvert automatiquement en lecture seule, le code pourrait être
Private Sub Workbook_Open()
Dim date_i As Range
For Each date_i In Feuil1.Columns("D").SpecialCells(xlCellTypeConstants)
If date_i.Value <= Date Then Call Mail: Exit For
Next date_i
DoEvents
If ThisWorkbook.ReadOnly Then ThisWorkbook.Close
End Sub
Thev,
Encore une fois merci pour ton retour et pour ton aide.
Après quelque test de la nouvelle macro, voilà ce qu’il en ressort :
Lorsque l’on ouvre le fichier, il demande automatiquement (sans la macro) si on veut ouvrir le fichier en lecture seule, ou non. Donc en un simple clic le fichier peut être fermé.
Si on décide de l’ouvrir en lecture seule, alors le fichier essaye de se fermer (via ta macro) et propose d’enregistrer ou non. Un second clic supplémentaire.
Le mieux ne serais donc pas de partager le fichier et via un Msg Box de fermer ou non celui-ci ?
Dans l’attente de ton retour.
Cordialement,
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Pour éviter cela, apporter cette modificationMrJuice a écrit :Si on décide de l’ouvrir en lecture seule, alors le fichier essaye de se fermer (via ta macro) et propose d’enregistrer ou non. Un second clic supplémentaire.
Private Sub Workbook_Open()
Dim date_i As Range
On Error Resume Next
For Each date_i In Feuil1.Columns("D").SpecialCells(xlCellTypeConstants)
If date_i.Value <= Date Then Call Mail: Exit For
Next date_i
DoEvents
If ThisWorkbook.ReadOnly Then ThisWorkbook.Close savechanges:=False
End Sub
Cela vient du fait que le fichier a été enregistré en lecture seule recommandée.MrJuice a écrit :Lorsque l’on ouvre le fichier, il demande automatiquement (sans la macro) si on veut ouvrir le fichier en lecture seule, ou non. Donc en un simple clic le fichier peut être fermé.
Ma proposition est de l'enregistrer normalement et de l'ouvrir en lecture seule à l'ouverture de la session Windows.
Si l'ouverture se fait
- via une ligne de commande avec Excel.exe, il suffit d'ajouter le commutateur /r (voir https://support.office.com/fr-fr/article/Commutateurs-de-ligne-de-commande-pour-Excel-321cf55a-ace4-40b3-9082-53bd4bc10725)
- via un script VBS (je te donnerai la modification à apporter)
Thev,
Merci pour ton retour.
L'ouverture du fichier ce fait au démarrage de la session via un raccourci placer dans :
"C:\Users\[ID de MrJuice]\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup"
Cela s'applique à l'un des deux cas que tu présente dans ton dernier Post ?
Cordialement,
- Messages
- 4'092
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour,
Cela s'applique au premier cas mais il faut modifier ton raccourci ainsi :
"<chemin de l'exécutable Excel>.excel.exe" /r "ton raccourci actuel"
Exemple: "C:\Program Files\Microsoft Office\Office15\EXCEL.EXE" /r "D:\Data\Documents\Classeur3.xlsm"
Par ailleurs pour éviter de laisser l'application Excel ouverte, modifier le code ainsi :
Private Sub Workbook_Open()
Dim date_i As Range
On Error Resume Next
For Each date_i In Feuil1.Columns("D").SpecialCells(xlCellTypeConstants)
If date_i.Value <= Date Then Call Mail: Exit For
Next date_i
DoEvents
If ThisWorkbook.ReadOnly Then Application.DisplayAlerts = False: Application.Quit
End Sub
Thev,
J'ai finalement modifié quelque petite chose à ma sauce, et je suis vraiment ravis du résultat ^^
La macro au lancement :
Private Sub Workbook_Open() '#Thev : VBA activée à l'ouverture du fichier
Dim date_i As Range
Dim ret As Integer
'Msg pour connaître la raison de l'ouverture du fichier
ret = MsgBox("Souhaitez-vous modifier le fichier ?", vbYesNo, "Demande de confirmation")
If ret = vbYes Then
Exit Sub 'Si ouverture pour modification aucune macro n'est lancée
Else
On Error Resume Next
For Each date_i In Feuil1.Columns("D").SpecialCells(xlCellTypeConstants)
If date_i.Value <= Date Then Call Mail: Exit For
Next date_i
DoEvents
If ThisWorkbook.ReadOnly Then ThisWorkbook.Close savechanges:=False
End If
End Sub
Nouveau : Rajout du MsgBox pour exécuter les macros et fermer le fichier, ou pour ouvrir le fichier sans lancer les macros.
Sub Mail() 'envoie du mail si la VBA Private Sub est lancer
If Range("B4") = Date Then 'Vérification mail déjà envoyer ou non
ActiveWorkbook.Close False 'fermer le fichier sans sauvegarder si mail déjà envoyer
Else
Dim a As MailItem 'Si la date du jour n'est pas égal à celle en B4 alors lancement macro mail
Set a = Outlook.CreateItem(olMailItem) 'utilisation d'Outlook pour l'envoie de l'email
With a
.To = "xxx@xxx.com" 'destinataire
.Subject = "Tableau des chèques à encaisser en différer" 'Objet du mail
.Attachments.Add ("N:\[...]\Tableau des chèques en différé.xlsm") 'chemin d'accès à la pièce jointe
.Body = "Bonjour," & vbLf & vbLf & "Je vous invite à trouver en fichier joint le tableau des chèques à encaisser en différé." & vbLf & vbLf & "Merci de bien vouloir en prendre connaissance pour visualiser les chèques à encaisser aujourd'hui." & vbLf & vbLf & "Cordialement," & vbLf & vbLf & "Julien Pereira" & vbLf
.Send 'envoyer le mail
End With
Range("B4").Select 'Rajout de la date du jour en B4
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False 'Copier / Coller uniquement les données
ActiveWorkbook.Close True 'fermer le fichier en sauvegardant le rajout de la date
End If
End Sub
Nouveau : Rajout d'une cellule date pour éviter plusieurs fois l'envoie de l'e-mail le même jour.
Nouveau : Selon les choix du MsgBox ou de la cellule date, le fichier se ferme tout seul en enregistrant automatiquement ou non.
Du coup j'ai tester tout sa et sa fonctionne super bien ^^
Encore un grand merci pour ton aide
+++