la méthode range de l'objet global a échoué

**stéphane35200** · 13/11/2014, 19h29

bonsoir,

Voila j'ai un petit souci ce code envoi de mail avec ajout fichier pdf pièce jointe et pièce bis me met
"la méthode range de l'objet global a échoué"ne connaissant que très peut je n'arrive pas a voir ce qui cloche
a votre bon coeur

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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
Sub Enregistrer_transmettre_PDF()
'
' Enregistrer_PDF Macro
'
'
Dim fichier As String
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="alcoataudon" 'on enlève le mot de passe
With Worksheets("convocs")
.PageSetup.BlackAndWhite = True
.Range("A1:F34").PrintOut
.PageSetup.BlackAndWhite = False
End With
fichier = "C:\Users\xx\Documents\foot\Listing U13 SAISON 2013-2014v2.xlsm" & Range("B1") & " du " & Range("A101") & "" & Range("A102") & "" & Range("A104") & "" & Range("A105") 'on sélectionne le répertoire de destination avec le nom et la date du fichier
ActiveSheet.Range("A1:N34").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fichier, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=False 'on exporte au format PDF
 
Dim messageHTML
    On Error GoTo errorHandler
    'on crée le fichier PDF dans le même dossier que le fichier source
 
 
    Sheets("feuillmatch").ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
    ActiveWorkbook.Path & "\" & "feuillmatch.PDF" ' à changer  'Toute la Feuille
    piece_bis = ActiveWorkbook.Path & "\" & "feuillmatch.PDF" ' à modifier
 
    Range("A14:A34").Select
With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13434879
        .TintAndShade = 0
        .PatternTintAndShade = 0
End With
With Selection.Font
        .Color = -3342337
        .TintAndShade = 0
End With
    Sheets("Convocs").Range("$A$1:$F$34").ExportAsFixedFormat Type:=xlTypexslm, Filename:= _
    ActiveWorkbook.Path & "\" & "Convocs.PDF"   ' Ligne Modifiée ,    Modifier convocs
 
    Set objMessage = CreateObject("CDO.Message")
    objMessage.Subject = "Convocations U13"  'A modifier
    objMessage.From = "vv@free.fr" 'adresse mail de l'expéditeur n'est pas obligatoire
    objMessage.To = "vv@free.fr"    'Email du destinataire doit-être correct ici mettre les adresse mail séparer par des ;
    objMessage.CC = Range("b40") 'a modifier
    objMessage.BCC = "" 'Email copie cachée idem a from
    objMessage.TextBody = Range("A101") & Range("A102") & Range("A103") & vbCrLf & vbCrLf & Range("") & vbCrLf & vbCrLf & Range("A105")   ' A modifier
    piece_jointe = ActiveWorkbook.Path & "\" & "convocs.PDF" ' à modifier
 
    messageHTML = "Ceci est un message en HTML"
 
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.free.fr"   'mettre adresse serveur type A modifier
    objMessage.Configuration.Fields.Item _
    ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    objMessage.Configuration.Fields.Update
    objMessage.AddAttachment (piece_jointe) 'On ajoute la piéce jointe, il est possible d'envoyer plusieurs pièces
    objMessage.AddAttachment (piece_bis) 'dans ce cas on ajoute un objMessage.AddAttachement () par pièce
    objMessage.Send
    MsgBox "Le mail à bien été envoyé à """
    'la feuille PDF créée est supprimée après l'envoi
    Range("A15,A18,A20,A22,A24,A26,A28,A30,A32").Select
    Range("A32").Activate
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    Range("A16,A19").Select
    Range("A19").Activate
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Range("A21,A23,A25,A27,A29,A31,A33").Select
    Range("A33").Activate
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("A15").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15269765
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A18,A20,A22,A24,A26,A28,A30,A32").Select
    Range("A32").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16769217
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        ActiveSheet.Protect Password:="alcoataudon" 'on met le mot de passe
    Kill ActiveWorkbook.Path & "\" & "Convocs.PDF" 'à modifier
    'si erreur on sort de la procédure
    Exit Sub
errorHandler:
    'description de l'erreur survenue
    MsgBox Err.Description
    ActiveWorkbook.Save 'on sauvegarde
    Application.ScreenUpdating = True
 
End Sub