Bonjour,
Je souhaite copier coller une currentregion d'une feuille de calculs vers le corps d'un mail dans la fenêtre de rédaction thunderbird.
J'arrive à générer la fenêtre de rédaction avec le destinataire, le sujet ainsi qu'une partie du corps redondante voulus mais quand mon code colle ma currentregion copiée, je me trouve avec un texte illisible dans lequel se suivent toutes les valeurs des cellules de la currentregion sans aucune structuration formelle.
Le collage comme citation me semble-t-il reprend la forme de tableau d'origine.

Le code:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub Envoimail()
 
Application.EnableEvents = False
Application.Calculation = xlCalculationAutomatic
 
Sheets("ENVOI").Select
 
Dim Rep As Integer, destinataire As String, sujet As String, body As String, strcommand As String, TouchesEnvoi(5) As String
destinataire = Sheets(ActiveSheet.Index).Range("X2")
 
 
sujet = ConverAcute(Sheets("COMMUNICATION").Range("A1").Value)
 
 
 
body = ConverAcute(Sheets("COMMUNICATION").Range("C1").Value) 
strcommand = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird"
strcommand = strcommand & " -compose " & "to='" & destinataire & "'"
strcommand = strcommand & ",cc='" & Copie & "'"
strcommand = strcommand & ",subject='" & sujet & "'"
strcommand = strcommand & ",preselectid ='" & preselectid & "'"
strcommand = strcommand & ",body='" & body & "'"
Call Shell(strcommand, vbNormalFocus)
 
Application.Wait (Now + TimeValue("0:00:10"))
 
 
SendKeys ("{TAB}")
 
 
Application.ThisWorkbook.Activate
 
 
 
Range("A1").CurrentRegion.Select
Selection.Copy
 
 
 
Application.Wait (Now + TimeValue("0:00:10"))
 
 
ThunderbirdActivate
 
    SendKeys ("^+{DOWN}")
    SendKeys ("^+V")
 
 
 
Sheets("" & Format(Now, "DDMMYYYY") & "").Select
 
Dim Maintenant As Date, DerCol As Long
 
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
 
Maintenant = Now
 
Cells(ActiveCell.Row, DerCol).Value = "MAIL ENVOYE LE" & Chr(10) & Format(Maintenant, "dddd dd mmmm yyyy") & " A " & Format(Maintenant, "hh:mm:ss")
 
Application.EnableEvents = True
 
End Sub

Pour info, l'opération globale est la suivante:

- Sur une feuille comportant n lignes dont des adresses mails dans une colonne;
- Plusieurs lignes pour le même destinataire;
- Filtrer le tableau par adresses mails;
- Copier les n lignes concernant chaque adresse mail dans une feuille créée had oc;
- générer la rédaction du mail pour l'adresse alors concernée;
- copier le tableau de chaque destinataire dans le corps de son mail en dessous d'un texte commun à tous les destinataires;
- Supprimer la feuille de calculs créée ad hoc.

Mon problème:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
SendKeys ("^+V")
colle les données du tableau sans aucune structure, le rendant illisible pour le destinataire.


Je vous remercie d'avance!!!!!!!!!!!!!!