1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
| Sub test3()
Dim nom
Dim i As Integer
Dim j As Integer
With ActiveWorkbook.SlicerCaches("Segment_Conseiller_LAIT1")
'.ClearManualFilter
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = True
For j = 1 To .SlicerItems.Count
If j <> i Then .SlicerItems(j).Selected = False
Next j
nom = .SlicerItems(i).Name
' VERIFIER SI DOSSIER TEMP EXISTANT SINON LE CREER
If Dir("C:\Temp", vbDirectory) = "" Then MkDir ("C:\Temp")
If Dir("C:\Temp\Recap_" & nom & ".pdf") <> "" Then Kill ("C:\Temp\Recap_" & nom & ".pdf")
'COPIE DE LA FEUILLE EN PDF
Sheets("TDC Bilan Conseillers").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Temp\Recap_" & nom & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'ENVOIE DU MAIL AVEC LA PIECE JOINTE
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim currfile As String
Dim mail
Dim ligneA_agent As Long
Dim num_ligne As Long, trouve As Boolean
Dim resultat As String
trouve = False
'RECUPERATION DES INFORMATIONS POUR ENVOIE DU MAIL
'RECHERCHE DU NOM DE L'AGENT DANS FEUILLE MAIL
ligneA_agent = Feuil7.Range("A1").End(xlDown).Row
For num_ligne = 1 To ligneA_agent
If Feuil7.Range("A" & num_ligne) = .SlicerItems(i).Name Then trouve = True: Exit For
Next
mail = Feuil7.Range("B" & num_ligne)
' SI TROUVE EST FAUX SAISIE MANUELLE DE L'ADRESSE
If Not trouve Then
resultat = InputBox("Mail introuvable veuillez saisir une adresse mail valide", "Saisir adresse Mail")
mail = resultat
End If
'ENVOIE DU MAIL
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = mail
.Subject = "Prison Constat Alim"
.Attachments.Add "C:\Temp\Recap_" & nom & ".pdf"
.Display
.Send
End With
'SUPPRESSION DU FICHIER CREER POUR LE MAIL
Kill ("C:\Temp\Recap_" & nom & ".pdf")
Next i
.ClearManualFilter
End With
'MSGBOX POUR INDIQUER QUE LE TRAITEMENT EST TERMINE
Sheets("TDC Bilan Conseillers").Select
MsgBox ("Opération terminée")
ThisWorkbook.Save
End Sub |
Partager