J'ai créer un fichier avec un tableau croisé dynamique.
Je souhaite faire un envoie de mail automatique en filtrant successivement sur l'un des champs de mon tableau.
Jusque là ça fonctionne.
Mon problème est la mise en forme de mon mail :
[list]Je voudrais que le tableau que je copie ressemble à un tableau dans mon mail
/listJe voudrais que ma signature Lotus insère en automatique.
Voici le code que j'utilise :
Sub Mailing()
Dim s, t
'mise à jour du tableau croisé dynamique
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotCache.Refresh
'Boucle pour l'affichage des sous-traitant
For s = 1 To Cells(7, 1).Value
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Raison sociale")
.PivotItems(s).Visible = True
End With
If s = 1 Then
For t = s + 1 To Cells(7, 1).Value
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Raison sociale")
.PivotItems(t).Visible = False
End With
Next
Else
For t = s + 1 To Cells(7, 1).Value
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Raison sociale")
.PivotItems(t).Visible = False
End With
Next
For t = 1 To s - 1
With ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Raison sociale")
.PivotItems(t).Visible = False
End With
Next
End If
'envoie d'un mail en automatique
'Selectionne les données à copier dans le mail
Range(Cells(4, 4), Cells(Cells(6, 1).Value + 3, 12)).Copy
Set data = New DataObject
data.GetFromClipboard
'Définition des objects nécessaire pour automatiser un mail lotus notes
Dim Maildb As Object
Dim UserName As String
Dim MailDbName As String
Dim MailDoc As Object
Dim Session As Object
Dim EmbedObj As Object
Dim stsignature As String
'Démarrer une session de Lotus Notes
Set Session = CreateObject("Notes.NotesSession")
'Get the sessions username and then calculate the mail file name
'You may or may not need this as for MailDBname with some systems you
'can pass an empty string
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
'Ouvrir la base mail dans Lotus notes
Set Maildb = Session.GETDATABASE("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
'Définition du nouveau document mail
Set MailDoc = Maildb.CREATEDOCUMENT
stsignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
MailDoc.Form = "Memo"
MailDoc.Sendto = Cells(5, 1).Value
MailDoc.CopyTo = Cells(12, 1).Value
MailDoc.Subject = "Données de facturation : " & Cells(9, 1).Value
' Construction du corps du message
Set objNotesField = MailDoc.CREATERICHTEXTITEM("Body")
With objNotesField
.Appendtext "Bonjour,"
.AddNewLine 2
.Appendtext "Veuillez trouver ci-joint les éléments de facturation pour le mois de " & Cells(9, 1).Value
.AddNewLine 2
.Appendtext data.GetText
.AddNewLine 2
.Appendtext stsignature
.AddNewLine 2
End With
MailDoc.SaveMessageOnSend = SaveIt
'Envoie du mail
MailDoc.PostedDate = Now()
MailDoc.Send 0, Recipient
'Nettoyage de la base
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj = Nothing
Next
End Sub
