Envoi classeur Excel par outlook avec VBA
Bonjour,
J'ai créé un fichier de commande (avec l'aide de l'IA de Copilot) avec un code VBA et je souhaite ajouter une fonction ou lorsque je clique sur mon bouton de validation cela ouvre un nouveau mail avec un destinataire par défaut, un titre de mail et que le classeur Excel soit mis en pièce jointe puis lorsque le mail est envoyé le fichier excel doit effacer certaines cellules, s'enregistrer puis quitter excel.
Malheureusement je n'arrive pas à réaliser cette dernière fonction. Quand je clique sur mon bouton cela ouvre un nouveau mail avec le bon destinataire, le bon titre, le classeur Excel est bien en pièce jointe mais les cellules sont déjà vidées. Je n'arrive pas à faire en sorte que la pièce jointe soit le fichier avant l'effacement des cellules.
Avez vous une solution?
Je vous met ici mon code VBA:
Sub IncrementerNumeroCommande()
On Error GoTo ErrorHandler
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Page Commande")
' Initialisation ou incrémentation du numéro de commande
Dim currentOrderNumber As Long
If IsEmpty(ws.Range("C2").Value) Then
currentOrderNumber = 1
ws.Range("C2").Value = currentOrderNumber
ElseIf IsNumeric(ws.Range("C2").Value) Then
currentOrderNumber = ws.Range("C2").Value
ws.Range("C2").Value = currentOrderNumber + 1
Else
MsgBox "La cellule C2 ne contient pas un nombre valide.", vbExclamation
Exit Sub
End If
' Vérification de la case à cocher et de la valeur de B8
Dim chkBox As CheckBox
For Each chkBox In ws.CheckBoxes
If chkBox.TopLeftCell.Address = ws.Range("C8").Address Then
If chkBox.Value = xlOn And ws.Range("B8").Value <> "" Then
MsgBox "Veuillez vérifier la date de livraison souhaitée", vbExclamation
Exit Sub
End If
Exit For ' Sortie anticipée
End If
Next chkBox
' Copie des valeurs dans la feuille Historique Commande
Dim wsHistorique As Worksheet
Set wsHistorique = ThisWorkbook.Sheets("Historique Commande")
' Trouver la première ligne vide dans la feuille Historique Commande
Dim firstEmptyRow As Long
firstEmptyRow = wsHistorique.Cells(wsHistorique.Rows.Count, "A").End(xlUp).Row + 2 ' Ajout de 2 pour laisser une ligne vide
' Ajouter un remplissage gris à la ligne vide
wsHistorique.Range("A" & (firstEmptyRow - 1) & ":J" & (firstEmptyRow - 1)).Interior.Color = RGB(192, 192, 192)
' Copier les informations de la commande
wsHistorique.Range("A" & firstEmptyRow & ":J" & firstEmptyRow).Value = Array(currentOrderNumber, ws.Range("B4").Value, ws.Range("B3").Value, ws.Range("B5").Value, ws.Range("C7").Value, "", "", "", ws.Range("B8").Value, ws.Range("C4").Value)
' Copie des valeurs non vides de A10:A45, B10:B45, et C10:C45
Dim i As Integer, targetRow As Integer
targetRow = firstEmptyRow + 1 ' Commence à la ligne suivante après les informations de la commande
For i = 10 To 45
If ws.Range("A" & i).Value <> "" Or ws.Range("B" & i).Value <> "" Or ws.Range("C" & i).Value <> "" Then
wsHistorique.Range("A" & targetRow).Value = currentOrderNumber ' Numéro de commande
wsHistorique.Range("F" & targetRow).Value = ws.Range("A" & i).Value
wsHistorique.Range("G" & targetRow).Value = ws.Range("B" & i).Value
wsHistorique.Range("H" & targetRow).Value = ws.Range("C" & i).Value
targetRow = targetRow + 1
End If
Next i
' Ajout de "prochain groupage" si la case à cocher est cochée
For Each chkBox In ws.CheckBoxes
If chkBox.TopLeftCell.Address = ws.Range("C8").Address Then
If chkBox.Value = xlOn Then
wsHistorique.Range("I" & firstEmptyRow).Value = "prochain groupage"
End If
chkBox.Value = xlOff
Exit For ' Sortie anticipée
End If
Next chkBox
' Effacement des cellules spécifiées après affichage de l'email
Application.OnTime Now + TimeValue("00:00:10"), "EffacerCellules"
Exit Sub
ErrorHandler:
MsgBox "Une erreur s'est produite : " & Err.Description, vbCritical
End Sub
Sub EffacerCellules()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Page Commande")
ws.Range("B4, B5, B8, C4, C7, C8, A10:A45, B10:B45").ClearContents
ThisWorkbook.Save
Application.Quit
End Sub
Bonjour,
Je ne vois pas dans votre code la partie en lien avec Outlook. A priori, si cette macro est lancée après l'ajout du fichier joint et l'envoi du mail il ne devrait pas y avoir d'erreur. Cependant si le mail n'est pas encore envoyé, il est possible que Outlook n'ai pas vraiment attaché le fichier, simplement créé un lien vers votre fichier, et lors de l'envoi il prenne la dernière version.
Personnellement j'utilise toujours un fichier spécifique, à part du fichier "mère" pour joindre automatiquement en VBA. Vous pourriez utiliser ThisWorkbook.SaveCopyAs dans un dossier temporaire, et lier ce fichier à l'email. Cela règlera à 100 % le problème, en plus vous avez un suivi des envois. Éventuellement vous pouvez aussi supprimer ce fichier après l'envoi (toujours en VBA) si vous n'en avez pas besoin.