Echec envoi par mail aprés filtre..!?
Bonjour à tous,
Je bataille depuis plusieurs heures pour adapter un script VBA à mon usage personnel. ( Au passage, merci à son auteur..
Ce code me permets d'envoyer une sélection d'enregistrements en fonction de leurs propres destinataires.
J'ai bien avancé et jusque là tout semble fonctionner, oui, mais... Il y a toujours un "mais" pour ceux qui ne sont pas doués
Ce code qui est construit autour de 2 feuilles me remonte une erreur lorsqu'il boucle sur la seconde, normal, me direz-vous, puisque je ne travaille que sur une feuille
Quelle modification dois-je apporter pour ne travailler que sur la feuille active ?
Aussi, si je filtre à la main le champs "semaines" avant de lancer la macro, le script remonte une erreur.
Comment contourner cette erreur et n'envoyer que la sélection après filtre ?
Je vous joins le fichier pour exemple.
Merci de votre aide
Bonjour,
à tester,
Sub envoi_recapHS()
Dim recapHS 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
' For Each Feuille In ThisWorkbook.Worksheets
' Feuille.Name = "Données"
'.... 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("A").Hidden = True 'masquage colonne A
.Columns("J:K").Hidden = True 'masquage colonnes J à K
.Columns("M:O").Hidden = True 'masquage colonnes M à O
.Columns("Q:R").Hidden = True 'masquage colonnes Q à R
'sélection et stockage des lignes du rapport dans le dictionnaire
For Each ligne In .UsedRange.Rows 'lignes utilisées
destinataire = ligne.Columns("K").Value
Set ligne_à_envoyer = ligne.SpecialCells(xlCellTypeVisible)
If destinataire <> Empty Then
If Not recapHS.Exists(destinataire) Then recapHS.Add Key:=destinataire, Item:=ligne_à_envoyer _
Else Set recapHS(destinataire) = Union(recapHS(destinataire), ligne_à_envoyer)
End If
Next ligne
'réaffichage des colonnes ne figurant pas dans le rapport
.Columns("A").Hidden = False 'masquage colonne A
.Columns("J:K").Hidden = False 'masquage colonnes J à K
.Columns("M:O").Hidden = False 'masquage colonnes M à O
.Columns("Q:R").Hidden = False 'masquage colonnes Q à R
End With
'..... création classeur temporaire avec copie feuille en cours
With ActiveSheet
.Copy
End With
ActiveSheet.Range("A:A").Delete 'suppression colonnes non affichées dans le rapport
'.... récupération des lignes du rapport à partir du dictionnaire et stockage dans une page Web
For Each destinataire In recapHS.Keys
If destinataire = "Usermail" Then
Set ligne_entête = recapHS(destinataire)
Else
'création rapport dans le classeur temporaire
Set lignes = Union(ligne_entête, recapHS(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\recapHS.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 = fso.OpenTextFile(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
recapHS.RemoveAll 'réinitialisation dictionnaire
'..... message fin traitement
If traitement_ok Then MsgBox "Récapitulatif heures sup envoyé aux destinataires"
'Next Feuille
End Sub
Bonsoir SabV,
Merci beaucoup de t'être penché sur mon problème.
Une partie du problème est résolu
Set ligne_à_envoyer = ligne.SpecialCells(xlCellTypeVisible)
Et là, je sèche toujours ..
re,
si tu transforme les données de l'onglet "Données" en tableau
tu pourrais modifier la ligne
For Each ligne In .UsedRange.Rows 'lignes utilisées
par
For Each ligne In .ListObjects("Tableau1").DataBodyRange.SpecialCells(xlCellTypeVisible) 'lignes utilisées
fait un essai sur l'onglet "Données1"