Bonjour à tous,
j'ai farfouillé sur le net et ai trouvé une macro.
Cependant deux questions restent en suspens.
1° : cette macro positionne le tableau filtré en corps de message alors que je souhaiterais une pièce jointe;
2° : la macro plante à la ligne : With ActiveWorkbook.PublishObjects.Add(SourceType:=xlSourceSheet, Filename:=nom_fichier, Sheet:=ActiveSheet.Name) sans que je sache pourquoi...
Quelqu'un pour m'aider ?
d'avance merci !
Sub envoi_rapport()
Dim rapports As New Dictionary 'dictionnaire des lignes du rapport
Dim fso As New Scripting.FileSystemObject 'objet de gestion des fichiers
Dim ligne As Range, ligne_à_envoyer As Range, lignes As Range
Dim destinataire As Variant
Dim flux_texte As Object, fichier As Object
Dim erreur As Boolean, traitement_ok As Boolean
traitement_ok = True 'initialisation indicateur de traitement
'.... stockage des lignes du rapport dans un dictionnaire ayant pour clé l'adresse mail du destinataire
With ActiveSheet
'masquage des colonnes à ne pas faire figurer dans le rapport
' .Columns("B").Hidden = True
' .Columns("D:G").Hidden = True
'.Columns("J").Hidden = True
' .Columns("M:N").Hidden = True
' .Columns("P:R").Hidden = True
'sélection et stockage des lignes du rapport dans le dictionnaire
For Each ligne In .UsedRange.Rows 'lignes utilisées
destinataire = ligne.Columns("f").Value
Set ligne_à_envoyer = ligne.SpecialCells(xlCellTypeVisible)
If destinataire <> Empty Then
If Not rapports.Exists(destinataire) Then rapports.Add Key:=destinataire, Item:=ligne_à_envoyer _
Else Set rapports(destinataire) = Union(rapports(destinataire), ligne_à_envoyer)
End If
Next ligne
'réaffichage des colonnes ne figurant pas dans le rapport
'.Columns("B").Hidden = False
' .Columns("D:G").Hidden = False
'.Columns("J").Hidden = False
' .Columns("M:N").Hidden = False
' .Columns("P:R").Hidden = False
End With
'..... création classeur temporaire avec copie feuille en cours
With ActiveSheet
.Copy
End With
'MsgBox ("suppression des colonnes inutiles")
'ActiveSheet.Range("B:B,D😀").Delete 'suppression colonnes non affichées dans le rapport
'MsgBox ("Colonnes inutiles supprimées")
'Workbooks("Classeur14").Activate
'.... récupération des lignes du rapport à partir du dictionnaire et stockage dans une page Web
For Each destinataire In rapports.Keys
If destinataire = "Mail" Then
Set ligne_entête = rapports(destinataire)
'MsgBox (ligne_entête)
Else
'création rapport dans le classeur temporaire
Set lignes = Union(ligne_entête, rapports(destinataire))
With ActiveSheet
.Cells.Clear 'initialisation feuille
lignes.Copy .Range("A1") 'copie lignes du rapport
End With
'création rapport au format html
nom_fichier = "C:\temp\rapport.htm"
With ActiveWorkbook.PublishObjects.Add(SourceType:=xlSourceSheet, Filename:=nom_fichier, Sheet:=ActiveSheet.Name)
.Publish (True)
.AutoRepublish = False
End With
'récupération en texte du rapport au format html
Set flux_texte = fs😵penTextFile(nom_fichier)
html_texte = flux_texte.ReadAll
flux_texte.Close 'fermeture fichier temporaire
Set fichier = fso.GetFile(nom_fichier)
fichier.Delete 'suppression fichier temporaire
'envoi mail
Call envoi_mail(destinataire, html_texte, erreur)
If erreur Then traitement_ok = False
End If
Next destinataire
'..... fermeture classeur temporaire et réinitialisation dictionnaire
ActiveWorkbook.Close SaveChanges:=False 'fermeture classeur temporaire
rapports.RemoveAll 'réinitialisation dictionnaire
'..... message fin traitement
If traitement_ok Then MsgBox "rapports envoyés à leurs destinataires"
End Sub
