Bonjour,
J'ai une macro qui me permet de copier la feuille entière d'un classeur X vers une nouvelle feuille et de l'envoyer par mail (sans formules, seulement les valeurs). Maintenant que je vais commencer à appliquer quelques filtres sur le fichier source, je voudrais que la macro me permette d'envoyer que les cellules visibles. J'ai essayé avec quelques macros similaires que j'ai trouvé sur Internet mais je n'y arrive pas.
Quelqu'un pourrait m'aider et me dire où elle est l'erreur? Je pense que c'est la partie soulignée du code qui bloque.
Merci par avance de votre aide.
Sub Envoi_Liste()
Dim ExtFichier As String
Dim FileFormatNum As Long
Dim SourceFichier As Workbook
Dim FichierDest As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
Set SourceFichier = ActiveWorkbook
'Copier la feuille active à un nouveau classeur
Sheets("Listing").Copy.SpecialCells (xlCellTypeVisible)
With Sheets("Listing")
.Copy
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
Set FichierDest = ActiveWorkbook
'Determiner la version d'Excel et le format du fichier
With FichierDest
If Val(Application.Version) < 12 Then
'Excel 97-2003
ExtFichier = ".xls": FileFormatNum = -4143
Else
'Excel 2007-2016
ExtFichier = ".xlsx": FileFormatNum = 51
End If
End With
'Enregistrer le nouveau classeur/Envoyer par mail/Supprimer
TempFilePath = Environ$("temp") & "\"
TempFileName = SourceFichier.Name
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With FichierDest
.SaveAs TempFilePath & TempFileName & ExtFichier, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "XXXXXX@xx.com"
.Subject = "Listing " & DateAdd("w", 1, Date) & " - XYZ"
.Body = "Bonjour," & vbCrLf & vbCrLf _
& "Veuillez trouver en pièce jointe la liste pour le " & (DateAdd("w", 1, Date)) & "." _
& vbCrLf & vbCrLf & "Cordialement," & vbCrLf & vbCrLf & "XXXXX"
.Attachments.Add FichierDest.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
'Supprimer le fichier temporaire
Kill TempFilePath & TempFileName & ExtFichier
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'Confirmation d'envoi
MsgBox "Le fichier a été envoyé."
Application.DisplayAlerts = True
End Sub