Bonjour le forum,

Je dispose d'une procédure qui pilote Outlook avec des destinataires différents, des pièces jointes différentes, et des signatures différentes.

Mon problème :

Si j'utilise

Code : Sélectionner tout - Visualiser dans une fenêtre à part
Application.ScreenUpdating = False
la copie ci-dessous initiée par les "Sendkeys" ne s'exécute pas.

J'ai essayé de contourner ce problème par un userform masquant tout l'écran, le problème s'est répété.

Y a-t-il une raison à cet nconvénient, et/ou un moyen de le détourner.

Voici mon 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
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
Const Img_temp As String = "\Mes Documents\My Pictures\image_messages.jpg"
 
Sub Envoi_Documents()
 
  Dim Applic_Outlook As Outlook.Application
  Dim MonItem As Outlook.MailItem
  Dim Document As Range
  Dim Objet_Mail As String
  Dim Adresse_Mail As String
  Dim Fichier_joint As String
 
Sheets("Mail").Visible = True
Sheets("Mail").Select
 
Application.ScreenUpdating = False
'Quadrillage
ActiveWindow.DisplayGridlines = False
'Identifiant pour signature mail
[identifiant] = Application.UserName
 
'macro annexe renvoyant une variable Public nommée dossierrac
Call Dest_Export
 
 
Set Applic_Outlook = New Outlook.Application
 
'Parcourt en boucle les lignes
For Each Document In Sheets("Mail").Columns("D").Cells.SpecialCells(xlCellTypeFormulas)
 
    [corps_message_1] = Document.Offset(0, 3)
    [corps_message_2] = Document.Offset(0, 4)
 
    Call Plage_Mail
 
    Objet_Mail = Document.Offset(0, -1)
    Adresse_Mail = Document.Offset(0, -3)
 
    Set MonItem = Applic_Outlook.CreateItem(olMailItem)
    With MonItem
            .To = Adresse_Mail
            .Subject = Objet_Mail
            If Not IsEmpty(Document.Offset(0, -2)) Then .CC = Document.Offset(0, -2)
            .Categories = "Daily"
            Fichier_joint = dossierrac & Application.PathSeparator & Document
            .Attachments.Add Fichier_joint
            For I = 1 To 2
                If Not IsEmpty(Document.Offset(0, I)) Then
                    Fichier_joint = dossierrac & Application.PathSeparator  & Document.Offset(0, I).Value
                    .Attachments.Add Fichier_joint
                End If
            Next
            .Display
    End With
    Application.wait (Now + TimeValue("0:00:01"))
    AppActivate Objet_Mail & " - Message", 0   
    SendKeys "^v", True  
    Application.wait (Now + TimeValue("0:00:01"))
    SendKeys "%v", True  
    Application.wait (Now + TimeValue("0:00:02"))
Next
 
Set Applic_Outlook = Nothing
 
ActiveWindow.DisplayGridlines = True
 
End Sub
 
Sub Plage_Mail()
Call Image_Temporaire
End Sub
 
Sub Image_Temporaire(Optional dummy As Byte)
Dim cellule_corp As Range
Dim image_chart As ChartObject
Set cellule_corp = IIf(InStr([corps_message_1], "FanFan") > 0 Or InStr([corps_message_2], "dessous") > 0, Range("corps_2"), Range("corps_1"))
cellule_corp.CopyPicture xlScreen, xlBitmap
With cellule_corp
  Set image_chart = ActiveSheet.ChartObjects.Add( _
    .Left, .Top, .Width, .Height)
End With
With image_chart.Chart
  .Paste
  .Export filename:=Img_temp
End With
image_chart.Delete
Set image_chart = Nothing
Set cellule_corp = Nothing
End Sub
Par avance, je vous remercie.
Cordialement.
Marcel